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INTRODUCTION 



The Radio Shack computer system is a revolutionary 
device in economic, rather than in technical terms. Never 
before has so much computing power been available to so many 
people for so low a price. Its impact on the American life 
style has yet _to be determined, but is bound to be 
significant. 

The reduction in cost of the basic system and the 
associated peripherals will probably continue, as the market 
expands and the available technology develops. The long 
predicted era of the peoples" computer may finally be at 
hand. 

An example of the power and flexibility of even a 
moderately priced system is the book you now hold in your 
hands. With the exception of the brief descriptions 
appearing at the beginning of each program, this volume was 
produced by a TRS-80 system. 

First, program tapes from the files of Instant 
Software, Inc. were loaded from cassette into memory and 
saved on disc. Then, program listings, formatted by 
software, were printed out and photographically reduced to 
become the actual pages of the book. The table of contents, 
chapter heading pages and this introduction were written and 
edited with an Electric Pencil. Even the letters of 
acceptance to authors were filed, printed and addressed by 
our TRS-80. 

The book is divided into eight chapters. Each 
covers a broad range of program topics and, hopefully, 
includes something for everyone. We suggest that you scan 
each chapter to familiarize yourself with what is included. 
Then, choose what you like. 

Some of the programs are quite long and will present 
a challenge to those hardy enough to tackle typing them in. 
You will make fewer errors and become less fatigued, if you 
attempt only one page at a time. Also, take short breaks 
between bouts at the keyboard and double check each line for 
accuracy. 

Finally, it is our intention that this book provide 
the reader with more than a listing of program lines. We 
hope that it will be a teaching aid that will enable you to 
write better programs of your own. A wide range of 
programming styles and techniques are present, and some are 
better than others - try and find out as much as possible 
about program structure from these examples. We have loaded 
and run every program but have made no attempt to alter 
style - we leave that to you. Change lines, clean up 
subroutines, reduce lengths where possible, get rid of GOTO 
statements if you can - experiment! 



The Editors. 
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GEOGRAPHY TEST 1: by Mod Hallen 



This program will help get 
your foreign and state capitals 
straight, and keep them that 
way. A great reference tool or 
study aid for the worldly TRS-80 
owner. 




10 REM*-COMPUTER ASSISTED EDUCATION HARK VIII TRS-80 

20 REM*-ROD HALLEN TOMBSTONE, AZ 15 OCTOBER 1978 

30 REM*-EDU-KID "BEOl" TAPE 15 SIDE 1 150 

40 CLS:DIME$(20),FS(20),G$(20),N$(20),S$(12),S1S(12),A(50,2) 

50 DIMB$(50,4),B1S(20):GOSUB600 



l";TAB(63) ;CHR$U74) J 
[ [ HII I'M EDU--KID" 



( 



I";TAB(63) ;CHR$(174); 
) I BELIEVE THAT"; TAB (6 3) ;CHR$ 



<1";TAB(63) ;CHRS (174) ; 

) LEARNING CAN BE FUN1 ";TAB(63) ; 



60 PRINTCHRSI157) ;" [ 

70 PRINTCHR$(149);" [ [- 

(170); 
80 PRINTCHRSU57) ;" [ 

90 PRINTCHR$(149) ;" 

(170); 
100 PRINTCHR?(157) ;" !> (.) (.) 

110 PRINTCHR$(149);" ( () 

CHRSU70); 
120 PRINTCHRSU57) ;" ( ** ) " 

130 PRINTCHRSU49);" ( (====) ) 

3) ;CHR$(170) ; 
140 PRINTCHR$(157) ;" ( 

150 PRINTCHRSU49);" . ( ) 

160 PRINTCHR$(157) ;TAB(63) ;CHR$(174) ; 

170 GOSUB620 

180 PRINT:INPUT "WHAT IS YOUR NAME ";N$:CLS 

190 GOSUB600 

200 GOSUB610 

210 PRINTCHRSU83) ; TAB ( 22) ; "GEOGRAPHY CHOICE" ;TAB(63) ;CHR$(187) ; 

220 GOSUB610 



TAB(63);CHRS 



TAB(63) ;CHR$(174); 

LET'S PLAY WITH GEOGRAPHY." 



)";TAB(63) ;CHR$(174); 
";TAB(63),-CHR$(170); 



;TAB(6 



.STATE CAPITOLS 



.NONE OF THE ABOVE";TAB(63) ;CHR? (18 



230 PRINTCHR$(183) ,- " 

B(63) ;CHR?(187) ; 
240 GOSUB610 
250 GOSUB610 
260 PRINTCHR5U83) ;" 

7); 

270 GOSUB610 
280 GOSUB610 
290 GOSUB620 

300 PRINT: INPUT'WHICH ONE WOULD YOU LIKE TO TRY " ;C: IFC=0THEN340 
310 PRINT: INPUT'HOW MANY DO YOU WANT TO ANSWER (1 TO 50) ";P 
320 IFP=0 OR P>50THEN 340 
330 P=P+R:CLS:IFW+R=0THEN840ELSE960 

340 PRINT: INPUT'DO YOU WANT TO TRY MORE " ;A5 : PRINT: PRINT 
350 IFLEFT5(A$,1)="Y"THENCLS:GOTO190 
360 S=R/(W+R) :CLS:IFS>.90THEN S$="GREAT" :GOTO420 
370 IFS>.85THENSS="VERY GOOD" :GOTO420 
380 IFS>.79THENS$="GOOD":GOTO420 
390 IFS>.69THENS$="O.K.":GOTO420 
400 IFS>.50THENS$="FAIR":GOTO420 
410 S$="PRETTY POOR":CLS 
420 REM 
430 GOSUB600 
440 GOSUB610 
450 PRINTCHR$(183) ;" [ [ 

3);CHR$(187) ; 

470 PRINTCHRSI183) ;" ( [ [ [ 

480 PRINTCHR$(183) [ [ 

;CHR5(187); 

500 PRINTCHR$(183) ,-" ( 

510 PRINTCHR5U83) ;" !> (.) (.) 

) ;CHRS(187) ; 



2 FOREIGN CAPITOLS", -TA 



YOU GOT";R;" RIGHT ANSWERS" ;TAB(6 



;TAB(63) ;CHR$(187) ; 

OUT OF";W+R;"TRIES.",-TAB(63) 



)",-TAB(63) ;CHR$(187) ; 
<1 THAT'S ";S$;" 



;TAB(63 



530 PRINTCHRSU83);" ( ) \-TAB(63) ;CHR$ (187) ; 

540 PRINTCHRSU83);" ( ** ) THANK YOU FOR PLAYING WITH ME" 

(63);CHR$(187); 
550 PRINTCHR$(183);" ( (====) ) ";TAB(63) ;CHR$ (187) ; 

560 PRINTCHR$<183) ;" ( ) ";TAB(63) ;CHR$ (187) ; 

570 PRINTCHRSU83);" ( ) ";TAB(63) ;CHRS (187) ; 

580 GOSUB620 

590 END 

600 PRINTCHRS(183) ; :F0RK=1T062:PRINTCHRS (131) ; :NEXT:PRIKTCHR$(187) ;:RETURN 

610 PRINTCHRS(183);TAB(63);CHRS(187) ;: RETURN 

620 PRINTCHR$(183);:F0RK=1T062:PRINTCHR$(176) ; :NEXT:PRINTCHR$ (187) ,-:RETURN 

630 REM*-WRONG ANSWER SUBROUTINE-* 

l50ffl8TO66^9S;Il0%0,700,7"i0 W=W+l!A<H ' C)=0 

660 PRINT"SORRY, ";NS;", BUT THAT IS NOT RIGHT. " :GOT07 20 

670 PRINTNS;", YOU SHOULD KNOW BETTER THAN THAT. " :GOTO720 

680 PRINT'YOU'D BETTER TRY THAT ONE AGAIN LATER. " :GOT07 20 

690 PRINTNS;", EDUKID SAYS - TAKE ONE GIANT STEP - BACKWARDS !":GOTO720 

700 PRINT; "TRY AGAIN LATER I":GOTO720 

710 PRINT"THAT'S CLOSE, ";NS;", BUT CLOSE ONLY COUNTS IN HORSESHOES !" 

720 PRINT:PRINT" IT'S ";F$:PRINT:FORK=1TO2000:NEXT:RETURN 

730 REM*-RIGHT ANSWER SUBROUTINE-* 

740 H=RND (6 ): PRINT: PRINT" "; :R=R+1 :A(H,C) =1 

750 ONHGOTO760,770,780,790,800,810 

760 PRINT'YOU'RB ABSOLUTELY RIGHT 1":GOTO820 

770 PRINT'YOU GOT IT, ";N$;", KEEP IT UP.":GOTO820 

780 PRINT"THAT'S ANOTHER ONE. " :GOTO820 

790 PRINT"GOOD GOING. " :GOTO820 

800 PRINTNS;", YOU'RE DOING O.K. " :GOTO820 

810 PRINT"! KNEW YOU'D GET THAT ONE I" 

820 PRINT:IFR/5=INT(R/5)THENPRINT"THAT'S";R;"CORRECT ANSWERS SO FAR." 

830 FORK=1TO500: RETURN 

840 REM*-QUESTION AND ANSWER SUBROUTINE-* 

850 IFC=1THENC$="STATE" ELSECS="COUNTRY" 

860 PRINT"O.K.";NS;", iF i GIVE YOU THE CAPITOL, YOU NAME THE ";CS;"." 

870 PRINTiPRINT" IF i GIVE YOU THE ";C$;" YOU TELL ME THE CAPITOL." 

880 PRINT: PRINT" ANSWER STOP IF YOU WANT TO STOP." 

890 FORJ=1TO1000 

900 FORK=1TO50 

910 F0RL=1T04 

920 READB1S 

930 BS(K,L)=B1S 

940 NEXTL 

950 NEXTK 

960 FORJ=lTOP 

970 H=RND(50):IFA(H,C)=1THEN970 

980 IF(J+H)/2=INT((J+H)/2)THEN1030 

990 ES=B$(H,1) :FS=BS(H,2):IFC=2THENES=BS(H,3) :F$=B$(H,4) 

1000 PRINT :PRINTE$,-" " ; : INPUTGS: IFGS="STOP"THEN340 

1010 IFFS=GSTHENGOSUB740ELSEGOSUB640 

1020 GOTO1060 

1030 FS=B$(H,1):ES=B$(H,2):IFC=2THENF$=B$(H,3):ES=BS(H,4) 

1040 PRINT :PRINTES;" ";: INPUTGS :IFGS="STOP"THEN340 

1050 IFFS=GSTHENGOSUB740ELSEGOSUB640 

1060 IFR=50THENFORK=1TO2000:NEXT:GOTO360 

1070 IFR=PTHENJ=P 

1080 NEXTJ:GOTO340 

1090 DATA'PHOENIX" , "ARIZONA" , "LONDON" , "ENGLAND" 

1100 DATA'SACRAMENTO" , "CALIFORNIA" , "DUBLIN" , "IRELAND" 

1110 DATA"ALBANY","NEW YORK" , "AMSTERDAM", "HOLLAND" 

1120 DATA'TOPEKA" , "KANSAS" , "BRUSSELS" , "BELGIUM" 

1130 DATA"PORTLAND", "OREGON" , "PARIS" , "FRANCE" 

1140 DATA"SPRINGFIBLD" , "ILLINOIS" , "MADRID" , "SPAIN" 

1150 DATA"AUSTIN" , "TEXAS" , "LISBON" , "PORTUGAL" 

1160 DATA"JACKSON" , "MISSISSIPPI" , "OSLO" , "NORWAY" 

1170 DATA"TALLAHASSEE" , "FLORIDA" , "STOCKHOLM", "SWEDEN" 

1180 DATA"CHARLESTON","WEST VIRGINIA" , "HELSINKI" , "FINLAND" 

1190 DATA'LANSING" , "MICHIGAN" , "REYKJAVIK" , " ICELAND" 

1200 DATA"DOVER" , "DELAWARE" , "COPENHAGEN" , "DENMARK" 

1210 DATA"OLYMPIA", "WASHINGTON", "BONN", "WEST GERMANY" 

1220 DATA"CARSON CITY", "NEVADA", "EAST BERLIN" ."EAST GERMANY" 

1230 DATA"NASHVILLE" , "TENNESSEE" , "WARSAW" , "POLAND" 

1240 DATA"BOISE" , "IDAHO" , "PRAGUE" , "CZECHOSLOVAKIA" 

1250 DATA'ST. PAUL", "MINNESOTA", "VIENNA", "AUSTRIA" 

1260 DATA'HONOLULU" , "HAWAII" , "BUDAPEST" , "HUNGARY" 

1270 DATA'OKLAHOMA CITY", "OKLAHOMA", "BERN" , "SWITZERLAND" 

1280 DATA" ATLANTA" , "GEORGIA" , "ROME" , " ITALY" 

1290 DATA'RALEIGH", "NORTH CAROLINA", "ATHENS", "GREECE" 

1300 DATA"SANTA FE","NEW MEXICO"-, "MOSCOW", "RUSSIA" 

1310 DATA'MONTPELIER" , "VERMONT" , "BAGHDAD" , " IRAQ" 

1320 DATA'RICHMOND" , "VIRGINIA" , "TEHERAN" , " IRAN" 

1330 DATA'AUGUSTA" , "MAINE" , " ISTANBUL" , "TURKEY" 

1340 DATA"CHEYENNE", "WYOMING", "NEW DELHI "."INDIA" 

1350 DATA'FRANKFORT" , "KENTUCKY" , "BANGKOK" , "THAILAND" 

1360 DATA"LITTLE ROCK" , "ARKANSAS" , "PEKING" , "CHINA" 

1370 DATA'PIERRE", "SOUTH DAKOTA" , "TOKYO" , "JAPAN" 

1380 DATA" HARTFORD" , "CONNECTICUT" , " RABAT" , " MOROCCO" 



1390 


DATA 


1400 


DATA 


1410 


DATA 


1420 


DATA 


1430 


DATA 


1440 


DATA 


1450 


DATA 


1460 


DATA 


1470 


DATA 


1480 


DATA 


1490 


DATA 


1500 


DATA 


1510 


DATA 


1520 


DATA 


1530 


DATA 


1540 


DATA 


1550 


DATA' 


1560 


DATA' 


1570 


DATA' 


1580 


DATA" 



"BATON ROUGE" , "LOUISIANA" , "CAIRO" , "EGYPT" 
"MONTGOMERY" , "ALABAMA" , "CANBERRA" , "AUSTRALIA" 
"HELENA" , "MONTANA" , "WELLINGTON" , "NEW ZEALAND" 
"DENVER" , "COLORADO" , "OTTOWA" , "CANADA" 
"PROVIDENCE", "RHODE ISLAND" , "WASHINGTON D.C.","USA" 
"TRENTON", "NEW JERSEY" , "MEXICO CITY" , "MEXICO" 
"JUNEAU" , "ALASKA" , "HAVANA" , "CUBA" 
"CONCORD" , "NEW HAMPSHIRE" , "BOGOTA" , "COLUMBIA" 
"BISMARCK" , "NORTH DAKOTA" , "QUITO" , "EQUADOR" 
"SALT LAKE CITY", "UTAH", "LIMA", "PERU" 
"LINCOLN" , "NEBRASKA" , "LA PAZ" , "BOLIVIA" 
"DES MOINES", "IOWA", "SANTIAGO", "CHILE" 
"JEFFERSON CITY" , "MISSOURI" , "BRASILIA" , "BRAZIL" 
"MADISON", "WISCONSIN", "BUENES AIRES" , "ARGENTINA" 
"BOSTON" , "MASSACHUSETTS" , "MONTEVIDEO" , "URUGUAY " 
"COLUMBIA" , "SOUTH CAROLINA" , "CARACAS" , "VENEZUELA" 
"INDIANAPOLIS" , "INDIANA" , "ASUNCION" , "PARAGUAY" 
"COLUMBUS" , "OHIO" , "SOFIA" , "BULGARIA" 
"HARRISBURG" , "PENNSYLVANIA" , "BUCHAREST" , "RUMANIA" 
"ANNAPOLIS" , "MARYLAND" , "JERUSALEM" , "ISRAEL" 



ARITHMETIC DRILL: by G.M. Leupp 



This program takes you 
through the basics with varying 
levels of difficulty. Ideal as a self- 
teaching aid, since the computer 
can be prompted "H" for "help 
me", if an unsolveable problem 
is encountered. 



BO VOU MANT SOME HARDER PROBLEMS 
,.Y OP N>> N 

VOU HAD A TOTAL OF 2 TRIES AND 
ANSWERED CORRECTLY 2 TIMES FOR 
A GRADE' OF 108 PERCENT. 



CONGRATULATIONS! : , great WORK! 

I'M FINISHED BUT IF YOU UANT TO- 
CONTINUF. TYPE 'RUN' , 



1000 CLS 

1020 REM 2282 BYTES. TRS-80 LEVEL II BASIC. 

1060 RANDOM 

1080 PRINT" BASIC ARITHMETIC DRILL" :PRINT 

1100 PRINT'THIS PROGRAM WILL RANDOMLY GENERATE 2 NUMBERS FOR EACH PROBLEM 

1120 PRINT"AND WILL ALSO RANDOMLY GENERATE WHETHER IT WILL BE ADDITION, 

1140 PRINT"SUBTRACTION, DIVISION OR MULTIPLICATION. PROBLEMS WILL BE 

1160 PRINT "PRESENTED AT 3 LEVELS OF DIFFICULTY. PAY CLOSE ATTENTION TO 

1180 PRINT "THE ALGEBRAIC SIGNS1 IF YOU HAVE TROUBLE WITH THE ANSWER 

1200 PRINT"AND WANT HELP FROM THE COMPUTER TYPE 'H' AND THE CORRECT 

1220 PRINT'ANSWER WILL BE DISPLAYED. DO YOUR BEST AND I'LL KEEP SCORE TO 

1240 PRINT "LET YOU KNOW HOW WELL YOU'VE DONE WHEN YOU'RE FINISHED. 

1260 PRINT:PRINT "ROUND ALL YOUR DIVISION ANSWERS TO TWO DECIMAL PLACES. 

1280 PRINT: INPUT"HOW MANY PROBLEMS DO YOU WANT AT EACH DIFFICULTY LEVEL", -Z 

1300 PRINT" GOOD LUCK! 

1320 INPUT" PRESS 'ENTER' WHEN READY";AS 

1340 RANDOM 

1360 IF T>Z RESTORE 

1380 FOR K=l TO 250: NEXT K: CLS 

1400 PRINT CHR$(23) 

1420 IF T>3*Z-1 THEN 2140 

1440 IF T=0 THEN 1500 

1460 IF INT(T/Z)=T/Z THEN 1920 

1480 IF D>1 THEN 2060 

1500 L=RND(10) 

1520 M=RND(10) 

1540 PRINT 

1560 N=RND(4) 

1580 IP N=l PRINT L;"+";M;"= ";: CA=L+M 
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CA=L-M 

CA=INT(L/M*100+.5)/10O 

CA=L*H 



1600 IF N=2 PRINT L;"-":M;" 

1620 IF N=3 PRINT L;"/";Mi" 

1640 IF N=4 PRINT L;"*";M;" 

1660 INPUT A$ 

16 80 R=R+1 

1700 IF A$<>°H" THEN 17 80 

17 20 PRINT"THE CORRECT ANSWER IS";CA; 

17 40 T=T+1 

1760 FOR 1=1 TO 300: NEXT: GOTO 1360 

17 80 A=VAL(AS) 

1800 IF A=CA THEN 1860 

1820 PRINT"SORRY, PLEASE TRY AGAIN." 

1840 GOTO 1580 

1860 GOSUB 2340 

1880 GOTO 1360 

1900 PRINT 

1920 PRINT CHR?(23) 

1940 INPUT"DO YOU WANT SOME HARDER PROBLEMS (Y OR N)";R$ 

1960 IF R$="N" THEN 2140 

1980 D=D+1 

2000 PRINT 

2020 PRINT"O.K. HERE GOES ..." 

2040 PRINT 

2060 IF D=l L=RND(100): M=RND(10): GOTO 2100 

2080 L=RND(1000): M=RND(100) 

2100 GOTO 1580 

2120 PRINT 

2140 PRINT: PRINT"YOU HAD A TOTAL OF" ;R; "TRIES AND 

2160 PRINT"ANSWERED CORRECTLY" ;C; "TIMES FOR 

2180 PRINT'A GRADE OF" ; INT(C/R*100+. 5) ; "PERCENT." 

2200 PRINT:IF C=R PRINT : PRINT'CONGRATULATIONS 1 ! GREAT WORK!":PRINT 

2220 PRINT'I'M FINISHED BUT IF YOU WANT TO CONTINUE, TYPE 'RUN'." 

2240 PRINT:PRINT:END 

2260 DATA" CORRECT.", "YOU' RE RIGHT.", "YES INDEED." 

2280 DATA"RIGHT ON. ..", "EXCELLENT. ", "O.K. DO IT AGAIN" 

2300 DATA"THAT'S CORRECT. ", "NICE WORK.", "VERY GOOD.", "ALL RIGHT1 

2320 DATA"YES. YOU'RE OK!" 

2340 READ AS 

2360 PRINT: PRINT 

2380 PRINT " ";A$ 

2400 LET C=C+1: REM TO ACCUMULATE CORRECT RESPONSES 

2420 T=T+1 

2440 GOTO 1360:RETURN 

2460 END 
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SPELLING TUTOR: by Frank Derfler and G.M. Leupp 



Every writer, editor and stu- 
dent should have copy of this 
program in storage. Type in the 
words that you habitually mis- 
spell (up to 50). Your TRS-80 
will then ask you to pronounce 
the word, identify the correctly 
spelled version of it, order ran- 
domly placed letters into the 
word, or supply missing letters to 
complete the spelling of the 
word. A real workout. 







220 CLEAR 300 

240 DIM W$(50) 

260 PRINT" SPELLING TUTOR 

280 PRINT :PRINT"THIS PROGRAM WILL DRILL UP TO 50 WORDS OP ANY LENGTH. 

290 REM ACTUALLY, THE NUMBER OF WORDS IS RESTRICTED ONLY BY MEMORY RESTRICTIONS. 

295 REM IF MORE THAN 50, DIM STATEMENT IN LINE 240 SHOULD BE INCREASED ACCORDING 

LY. 
300 PRINT: PRINT: INPUT "HOW MANY WORDS WOULD YOU LIKE TO STUDY";X 
320 PRINT:PRINT"OK, PLEASE TYPE EACH BELOW. THEN PRESS THE 'ENTER" KEY. 
340 PRINT'CAREFUL . . . DON'T MAKE ANY MISTAKES I ":PRINT 
360 FOR 1=1 TO X 
380 PRINT I;"";: INPUT WS(I) 
400 IF WS(I)="" THEN GOTO 380 
420 NEXT 
440 CLS 

460 PRINT" TIME FOR SOME SPELLING FUN!:? 
480 INPUT'WHAT'S YOUR NAME ";Z$ 

500 PRINT:PRINT"HI "iZ$;", HERE ARE OUR SPELLING WORDS." 
520 PRINT"PLEASE SAY EACH WORD AS IT IS PRINTED. 
540 FOR Y=l TO 1500:NEXT:REM DELAY LOOP 
560 FOR W=l TO X 
580 PRINT:PRINT 
600 FOR 1=1 TO X 

620 PRINT WS(I):FOR V=l TO 1000:NEXT 
640 PRINT 
660 NEXT 

680 FOR V=l TO 1000:NEXT:CLS 

700 PRINT"GOOD WORK! NOW 1 AM GOING TO GIVE YOU ONE WORD AT A TIME WITH 
710 PRINT"THE LETTERS BACKWARDS. SEE IF YOU CAN TYPE EACH ONE CORRECTLY. 
720 FOR 2=1 TO 1000: NEXT Z:REM DELAY LOOP 
740 FOR 1=1 TO X 
760 PRINT 
780 MS=W$(I) 

800 FOR R=LEN(MS) TO 1 STEP -1: PRINT MIDS (MS,R,1) ; :NEXT R 
820 INPUT" ";SS: IF S?=M$ GOSUB 900ELSE GOSUB 980 
840 IF F>0 THEN 820 
860 IF I=X THEN 1060 
880 NEXT I 

900 G=0+1: ON G GOTO 920,940,960 

920 PRINT" GOODI YOU GOT THAT ONE1":F=0: 0=0+1: PRINT: RETURN 

940 PRINT" WASN'T THAT EASYl": F=0: 0=0+1: PRINT: RETURN 

960 PRINT" SUPER, ";Z$: 0=0: F=0: PRINT: RETURN 

980 G=F+1: ON G GOTO 1000,1020,1040 

1000 PRINT" OOOPS! NOT QUITE ";Z$;". TRY AGAIN. " :P=F+1 : RETURN 

1020 PRINT" N0, ONE MORE TIME. " :F=F+1 : RETURN 

1040 PRINT" SORRY, ";ZS;". THE WORD IS ' ";W$ (I) ; "' " : F=0: RETURN 

1060 FOR C=l TO 1000: NEXT C: CLS 

1080 CLS: PRINT" NOW I AM GOING TO PRINT EACH WORD WITH SOME LETTERS 
1100 PRINT" MISSING AND AN * PUT IN THEIR PLACE. CAN YOU SPELL THEM 
1120 PRINT" CORRECTLY? IF YOU DON'T KNOW THE WORD, TYPE 'H' FOR HELP 
1140 PRINT" AND I WILL GIVE YOU ONE MORE LETTER. TYPE 'HH' IF 
1150 PRINT" YOU REALLY GET STUMPED. 
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1160 PRINT: FOR C=l TO 1000: NEXT C 

1180 FOR 1=1 TO X 

1200 MS=WS(I) 

1220 IF LEN(MS)>4 THEN 1260 

1240 PRINT LEFTS (MS, 2) ;: FOR Y=3 TO LEN(HS): PRINT"*"): NEXT Y: GOTO 1380 

1260 PRINTLEFT$(M$,2)l"**";MIDS(MS,5,l);:FOR Y=6 TO LEN(HS) 

1280 PRINT"*"):NEXT Y: GOTO 1380 

1300 IF LEN(MS)>4 THEN 1340 

1320 PRINTLEFT$(MS,3);: FOR Y=4 TO LEN(MS): PRINT"*";: NEXT Y: GOTO 1380 

1340 PRINTLEFT$(MS,3);: PRINT"*";: PRINTHIDS (MS, 5,1) ; : FOR Y=6 TOLEN(HS) 

1350 PRINT"*"; 

1360 NEXT Y: GOTO 1380 

1380 REM 

1400 INPUT" ";HS: IF BS="H" THEN 1300 

1410 IF H$="HH" GOSUB 1040: GOTO 1440 

1420 IF HS=MS GOSUB 900 ELSE GOSUB 980 

1440 IF F>0 THEN 1380 

1460 IF I=X THEN 1480: NEXT I 

1480 NEXT I 

1500 FOR V=l TO 1500: NEXT V: CLS: PRINTTAB(20) "NOW FOR MORE FUN!" 

1520 PRINT:PRINT: PRINT"SOME OF THE NEXT WORDS MAY BE CORRECT. SOME OF THEM 

1540 PRINT" (MAYBE ALL OF THEM) WILL HAVE THE WRONG LETTERS IN THEM. 

1560 PRINT"YOUR JOB IS TO TYPE EACH WORD CORRECTLY." 

1580 FOR V=l TO 1000: NEXT V: PRINT: PRINT: PRINT: FOR 1=1 TO X 

1600 MS=W$(I) 

1620 VS="AEIOU" 

1640 KS=MS 

1660 FOR D=l TO LBN (MS) 

1680 DS=MIDS(M$,D,1) 

1700 IF D$="A" OR DS="E" OR DS="I" OR DS="0" OR DS="U" THEN 1740 

1720 GOTO 1780 

1740 V=RND(5): QS=MIDS(VS,V,1) 

1760 KS=LEFTS(KS,D-1)+QS+RIGHTS<KS,LEN(KS)-D) 

1780 NEXT D 

1800 PRINT KS 

1820 INPUT" ";L$: IF LS=MS GOTO 1880 ELSE GOSUB 980 

1830 IF F>0 THEN 1820 

1840 IF I=X THEN 1910 

1860 NEXT I 

1880 E=E+1: GOSDB 900 

1900 GOTO 1840 

1910 IF E/X<.8 PRINT" YOU CAN DO BETTE R.":GOTO 1940 

1920 PRINTTAB(10)"H U R R A Y" 

1940 PRINTTAB(10)"Y O U GOT ";E;" RIGHT" 

1960 PRINTTAB(10)"O UT OF THE LAST ";X;" WORDS!" 

1980 PRINT:INPUT" DO YOU WANT TO REVIEW THE SAME WORDS AGAIN (Y OR N)",-A$ 

1990 IF AS<>"N" CLS: E=0 GOTO 520 

2000 PRINT:PRINT" THAT WAS FUN ";Z$;". LET'S DO IT AGAIN SOON . " 
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MATH DUEL: by William Laird 



Think you can add, subtract, 
multiply and divide? Think 
again. Your TRS-80 will have 
your head spinning in minutes 
with this program. All levels of 
play from grade school to gradu- 
ate. An excellent choice for those 
trying to wean themselves off 
calculators. 




5 CLSsRANDOM:TT(l).=B:TT(2>=8:T(l)=0:T(2>=0:DEFINT C,D,G,I,L,M,Q,T,X,Y,Z,W:CLEAR1 

10 ClI!pRI N TCHR$(23>:FORI=15360TO15423:POKEI,134:NEXT:FORI^^^^ 

2:NBXT!FORI=15360TO16320STEP64:POKEI,158:NEXT:FORI=15422TO16382STEP64.POKEI 

15 PrIntIi^"* MATH DUEL »";:PRINT<!394,"3"; : PRINTe454,"X 2"; : FORI=12T027 :SET(I, 
20 FORU56TO69S??19)!NEXT = FORI-19T022 = SET(56,I).NEXT:PRINTe352,'7",:PRINTe47 

« FnR4l4BTO?f-SETtl!39^NEXT:PRINT8728,"5"!:PRmTe788,"+ 3" ; : PRINT6920,"8" ; 
i roS"96TO!li!lETU,3BiSi=PR?N5e564,"9 i ,«PRIlITe624."- 4"; = PRINT6756, "5" ; 

35 FORI=1TO4008:NEXT 

40 CLS-PRINT626B,CHRS(23)"HOW MANY PLAYERS? {1 OR 2)"; 

45 PRINT<?452,"D0 YOU WISH TO PRACTICE "; : PRINT6516, "OR TAKE A TIMED TEST?", 

46 PRINT6644,"TYPE 1 FOR PRACTICE"; :PRINT67 18, "2 FOR TEST"; 

47 BBS=INKEYS:FORI=1TO250BB:ES=INKEY$:E=VAL(E$):IFE?<>""ONEGOTO50,50 

48 NEXT:E=1 

5B CLS:PRINTCHRS(23):PRINTe398,"WHAT IS YOUR NAME ; 

51 INPUT* ";A$(D 

53 IFN=2THENPRINTe644,"WHAT IS THE CHALLENGERS NAHE?"ELSE60 

55 INPUT" ";A$(2) 

60 GOSUB600:GOSUB700 ™„™„. 

,82,82,82,82 
81 NEXT:Q(1)=1 
SI BBS:WKm-FORI=lTO2500B:Q?(2)=INKEYS:Q(2)=VAL(QS(2))=IFQS(2)O""ONQ(2)GOTO85 

,85,85,85,85 

84 NEXT:Q(2)=1 

85 CLS:GOSUB6B0:GOSUB720 _ „„-.„_. 

86 IFN=2THENPRINT@855,AS(1);" FIRST, ";A$(2); SECOND ; 

88 PRINT6708,"TYPE THE NUMBER CORRESPONDING TO YOUR LEVEL ; ._„.„, ..... NRM , co 

89 BB$=INKEY$iPORI=lTO25BB0:B$(l)=INKEYS:B(l)=VAL(B$(l)):W=l=IFB$(l)<> ONBdlGO 

T093,94,95,96,97 
IS MS=iNKEYi:PORI=lTO25BB0=BS(2)=INKEY5:B(2)=VAL(BS(2)):W=2 : IFBS(2)<>""THENONB( 

2)GOT093,94,95,96,97 

92 NEXT:B(2)=1 

93 DA(W)=1B:DM(W)=3:G0T098 

94 DA(W)=44:DM(W)=5:GOT098 

95 DA(W)=54:DM(W)=10:GOTO98 

96 DA(W)=85:DM(W)=12:GOT098 

11 DMW-STRSIDMW)) :DMS <W)=STRS (DM (W) ) :D(W)=LEN (DAS (W) 1*100 :IFW=1ANDN=2THENG0T 

O91ELSEW=1:ONQ(1)GOTO1B8,200,300,400,500 
U0 Mfi?=RND(DA(W)):RA(2)=RND(DA(W))=RC=RA(l) + RA(2)=RCS=STRS(RC)=L=LEN(RC$)-l 
120 GOSUB62B:PRINTe534,"+";:GOSUB950 
140 GOTO630 

150 STOP _ 

20B GOSUB610 
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218 RA(1)=RND(DA(W)) :RA(2)=RND(DA(W) ) : IFRA (1) >RA (2) THENRC=RA(1) -RA<2) :RC$=STRS(R 

C):L=LEN(RC$)-1:GOTO220 
215 R1=RAU) :RA(1)=RA(2) :RA(2) =R1:RC=RA(1)-RA(2) :RC$=STRS(RC) :L=LEN(RCS> -1 
220 GOSUB620:PRINT8534,"-";:GOSUB950 
240 GCTO630 
250 STOP 
300 GOSUB610 

310 RA(1)=RND(12):RA(2)=RND(DM{W)):RC=RAU)*RA(2):RC$=STR$<RC):L=LEN(RC$)~1 

315 IFRA(1)<RA(2)THENR=RA(1):RA(1)=RA(2):RA<2)=R 

320 GOSUB620:PRINT8534,"X*;:GOSUB950 

340 GOTO630 

350 STOP 

400 GOSUB610 

410 RA(1>=RND(DM(W)):RA(2)=RND(DM(W)):RD=RA(1)*RA(2):RC$=STR$(RA(1)):L=LEN{RC$)- 
1:RD$=STR$(RD) 

415 PRINTCHR$(23):FORI=48T073:SET(I,25):NEXT:FORI=25T029:SET(48,I):NEXT 

420 PRINT8602,RD:PRINT8588,USING"#M##";RA(2) :GOSUB950 

440 IFLEN(RD$)=LEN(RC$)THENP=476:GOTO1000 

441 IFLEN(RD$)-1=LEN(RC$)THENP=478ELSEP=480 

450 GOTO1000 

451 STOP 

500 Z=RND(4) :ONZGOTO100,200,300,400 

600 CLS:FORI=15360TO15423:POKEI,183:NEXT:FORI=16320TO16383:POKEI,183:NEXT:FORI=1 
5360TO16320STEP64:FOKEI,191:NEXT:FORI=15423TO16383STEP64:POKEI,191:NBXT:RET 

610 CLS:L=0:RC$="":R${1)="":R$(2)="":RS(3)="":RS(4)="":R$(5)="":RETURN 

620 PRINTCHR$(23):PRINT8472,USING"#M«#";RA(l):PRINT8536,USING"###«#";RA(2):FORI 
=44T071:SET(I,27) :NEXT:RETt)RN 

630 IFL=1THENP=672 

640 IFL=2THENP=670 

650 IFL=3THENP=66 8 

660 IFL=4THBNP=666 

670 IFL=5THENP=664 

680 GOTO1000 

690 STOP 

700 PRINT8148,"* * PROBLEM TYPES * *" ; : PRINTS260 , "1 . ADDITION" ,• :PRINT8324 , "2. SU 
BTRACTION" ; : PRINT8388, "3 . MULTIPLICATION" ; : PRINT8452, "4 . DIVISION" ; : PRINT85 
16, "5. MIXED PROBLEMS" ;:PRINT8708, "TYPE THE NUMBER CORRESPONDING TO THE KIN 
D OF PROBLEMS", - 

705 PRINT8772,"YOU WISH TO SOLVE"; 

710 RETURN 

720 PRINT8145,"* * DIFFICULTY LEVELS * *" ; : PRINT8260 , "1 . BEGINNER" ;: PRINT8324 , "2 
. NOVICE";:PRINT8388,"3. PROFESSIONAL" ; :PRINT8452, "4. EXPERT" ;: PRINT8516 , "5 
. MASTER", ■:PRINT8708, "TYPE THE NUMBER CORRESPONDING TO YOUR LEVEL"; 

730 RETURN 

900 CLS:FORI=15381TO15416:POKEI,131:NEXT:FORI=15495T015544:POKEI,131:NEXT:F0RI=l 
5623TO15672:POKEI,131:NEXT:FORI=15751TO15800:POKEI,131:NEXT 

910 FORI=15495TO156 87STEP64:POKEI,191:NEXT:FORI=15381TO15701STEP64:POKEI.191:NEX 
T:FORI=1S389TO15709STEP64:POKEI,191:NEXT:FORI=15399TO15719STEP64:POKEI,191: 
NEXT: FORI=15408TO15728STEP64:POKEI, 191 :NEXT:FORI=15416T015736STEP64 = POKEI.l 
91: NEXT 

920 PRINT887 , "GRADE" ; : PRINT895 , "CORRECT" ; : PRINT8105 , "MISSED" ; : PRINT8U4 , " TOTAL" ; 

r™^^ 20 ^!? SING " % *",-A$(l);:PRINT@214,G(l);"%";:PRlNTe222,C<l);:PR 

INT8232,M(1);:PRINT8241,TU); 
930 IFN=2THENPRINT8329,USING"% *";AS{2) ; :PRINT@342,G(2) ; "%"; :PRINT8350,C 

(2);:PRINT8360,M(2);:PRINT8369,T(2); 
940 RETURN 
950 PRINT84,A$(W) ; 
960 RETURN 

1000 BB$=INKEYS:T(W)=T{W)+1 
1005 PORI=lTOD(W) 

1010 IFRS(1)="THENRS(1)=INKEYS:IFR$(1)O""THENPRINT6P,R$(1);ELSE1110 
1020 IFL>=2ANDR$(2)=""THENRS(2>=INKEY$:IFR$(2)O""THENPRINT8P+2,R$(2);ELSE1110 
1030 IPL>=3ANDRS(3)=""THENR$(3)=INKEY$:IFR$(3)O""THENPRINT8P+4,R$(3);ELSE1110 
1040 IFL>=4ANDR5(4)=""THENR$(4)=INKEY5:IFR$(4)O""THENPRINT6P+6,RS(4);ELSE1110 

1050 IFL>=5ANDRS(5)="THENR$(5)=INKEY$:IFR$(5)O""THENPRINT@P+8,RS(5);ELSE1110 

1051 IPE=1THENV(W)=1:GOTO1060 t^i.woo 

1052 V(W)=I/D(W):IPV(WX.65THENV(W)=(I/D(W)) + (1-(I/D(W)))/1.5ELSEV(W)=1 
1060 IFL=1THENR$=R$(1):GOTO1120 

107 IFL=2THENR$=R$ ( 1 ) +R$ ( 2 ) : GOTOll 20 

1080 IFL=3THENRS=R$(1)+RS(2)+RS(3) :GOTO1120 

1090 IFL=4THENRS=RS(1)+R$(2)+RS(3)+R5(4):GOTO1120 

1100 IFL=5THENR$=RS(1)+R$(2)+R?(3)+RS(4)+RS(5):GOTO1120 

1110 NEXT:D(W)=D(W)+10:PRINT8142,"* * TIME OUT * *" :IFQ(W) =40RZ=4THENFORI=1T05 :P 
RINT8346+(P-476) ,VAL(RCS) ; :FORU=1TO250:NEXT:PRINT8346, " " ; : FOKU=1T08 
0:NEXTU,I:GOTO1170 

1111 FORI=1TO5:PRINT8792,USING"*####";VAL(RC$);:FORU=1TO180:NEXT:PRINT87 92," 

";::NEXTI:GOTO1170 
1120 IPVAL{R$)=VAL{RCS)THENGOTO1200ELSE1140 
1125 D(W)=INT(D(W)*V(W)) 
1130 FORI=1TO1000:NBXT:GOTO1160 

1140 PRINT8148,"M I S S E D "; : IFQ(W) =40RZ=4THENF0RI=1T05 : PRINT8346+ (P-476) ,VAL( 
RC$);:FORU=lTO250:NEXT:PRINT8346+(P-476)," " ; :FORU=1TO80:NEXTU, I :G0T01 
170 

1141 FORI=1TO5:PRINT8792,USING"##IS#";VAL(RCS);:PORU=1TO250:NEXT:PRINT@792,," 

";:NEXTI:GOTO1170 
1160 C(W)=C(W)+1:GOTO1180 
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1170 
11819 
1182 
1184 
1190 
1195 
1200 
1210 
2000 

2010 
2020 
2030 
2040 
2050 
2060 
2100 
2110 
2120 
2130 
2140 
2150 
2170 
2200 
2210 
2220 
2230 
2240 
2250 



2270 
2280 



M(W)=M(W)+1:FORI=1TO1000:NEXT:CLS 
G(W)=INT(C(W)/T(W)*100):TT(W)=TT(W)+1 
IFN=2ANDTT(2)=20THEN2000 
IFN=1ANDTT(1) =20THEN2000 
IFN=2ANDW=1THENW=2ELSEW=1 
ONQ(W)GOTO100,200,300,400,500 

1FQ (W) =40RZ=4TBENPRINT8344 , "RIGHT"ELSEPRINT87 92 , "RIGHT" 
GOT01125 

TT(W)=0:GOSUB900:GOSUB2200:PRINT8644,"D0 YOU WISH TO CHANGE THE TYPE OF PRO 
BLEM? (YES/NO)" 
BBS=INKEY$:FORI=1TO25000 
Q$=INKEY$ 

IFLEFT$(Q$,1)="Y"THENGOSUB600:GOSUB700:GOTO76 
IFLEFT? (QS,1) ="N"THEN2100 
NEXT:GOTO2100 
STOP 

PRINT8772,"DO YOU WISH TO CHANGE THE PROBLEM DIFFICULTY? (YES/NO) 
BBS=INKEY?:FORI=1TO25000 
Q$=INKEY$ 

IFLEFT$(Q$,1)="Y"THENGOSUB600:GOSUB720:GOTO86 
IFLEFT5(Q$,D="H"THEN2170 
NEXT 

W=1:ONQ(W)GOTO100,200,300,400,500 

PRINT8452,"DO YOU WISH TO CONTINUE THE GAME? (YES/NO)" 
BB$=INKEY$:FORI=1TO25000:QS=INKEY$ 
IFLEFTS(Q$,1)="Y"THENRETURN 
I FLEETS (QS ,1 ) ="N"THEN2250 
NEXT: RETURN 

PRINT8662,"* HIT BREAK TO END *"; : IFN=2ANDG(1) >G(2)THENFORI=1TO500:PRINT873 
,"* WINNER *"i:PRINT8201,USING"% %";A$ (1) ; :FORU=1TO40:NEXTU:PRINT82 

01," "i:PRINT673," "; :FORU=1TO20:NEXTU:NEXT 

IFN=2ANDG(2)>G(1)THENFORI=1TO500:PRINT873,"* WINNER *";:PRINT8329,OSING"% 
%";A$(2)i:FORD=lTO40:NEXTU:PRUfT8329," "l :PRINT873," 

" ; : FORU-1TO20 : NEXTU : NEXT 
IFG(1)=G(2)THENFORI=1TO500:PRINT875,"T I E"; :PORU=1TO40:NEXTU:PRINT875," 

" ; : FORU=1TO20 :NEXTU: :NEXTI 
CLS:END 



CALCULATING AREAS, 1: by Carl A. Goldner 



This educational program il- 
lustrates methods of finding the 
areas of rectangles, circles and 
triangles. It is an excellent 
resource program for lower level 
math studies or math review use. 




10 CLS :DEFDBL A: PRINT8274,"* * * CALCULATING AREAS 
15 PRINTTAB(28)"PART ONE" 

17 PRINT : PRINTTAB ( 28 ) "RECTANGLES " 

18 PRINTTAB(29) "CIRCLES" 

19 PRINTTAB(28) "TRIANGLES" 

20 PRINTTAB(31)"BY" 
25 PRINT 

30 FOR X - 1 TO 1000: NEXT X 

40 CLS:PRINT8215,"* * * INDEX * * *": PRINT 

50 PRINT TAB(8)"TO FIND THE AREA OF ANY RECTANGLE . . 
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60 PRINT TAB(8) "TO FIND THE AREA OF ANY CIRCLE TYPE 2" 

70 PRINT TAB(8)"TO FIND THE AREA OF ANY TRIANGLE TYPE 3" 

80 PRINT TAB(8)"TO TAKE EXAMINATION TYPE 4" 

100 PRINT:PRINTTAB(14)"TYPE 1 , 2 , 3 OR 4 AND PRESS (ENTER)" 

110 PRINT: PRINT TAB(21)"YOUR SELECTION PLEASE";: INPUT S 

115 IF S<1 OR S>4 THEN GOTO 40 

120 CLS: ON S GOTO 200,600,2000,3000 

200 CLS :PRINT6347, "RECTANGLES": PRINT: FORX=1TO200 : NEXT 

205 FORX=1TO200:NEXT 

210 PRINT TAB(10)"A RECTANGLE IS A PLANE FIGURE BOUNDED BY FOUR STRAIGHT LINES A 

ND ENCLOSING FOUR RIGHT ANGLES." 
215 PRINT:GOSUB15000 
220 CLS:PRINT691,"FOR EXAMPLE" : FORX=1TO250 : NEXT 

225 PRINT6221,"SIDE (A)" 

226 PRINT6396,"SIDE (B) " 

230 Y=14:FORX=44T085:SET(X,Y) :NEXT 

240 Y=22:FORX=44T085:SET(X,Y) :NEXT 

250 X=44:FORY=15T021:SET(X,Y) :NEXT 

260 X=45:FORY=15T021:SET(X,Y) :NEXT 

270 X=84:FORY=15T021:SET(X,Y) :NEXT 

280 X=85:FORY=15T021:SET(X,Y) :NEXT 

292 PRINTS604, "RECTANGLE" 

294 PRINT :PRINTTAB( 24) "AREA = (A) X (B)" 

320 PRINT:GOSUB15000 

330 CLS:PRINT8335,"TO FIND THE AREA, FIRST BE CERTAIN THE LENGTH OF EACH SIDE IS 

GIVEN IN THE SAME UNITS OF MEASUREMENT." 
340 PRINT:GOSUB15000 

350 CLS:PRINT6269," AREA EQUALS SIDE (A) TIMES SIDE (B) " 
360 PRINT:PRINTTAB(13)"IF LENGTH OF SIDES IS IN INCHES THEN THE AREA IS IMSQUARE 

INCHES. IF LENGTH IS IN FEET THEN AREA IS IN SQUARE FEET"; 
370 PRINT". LIKEWISE MILES GIVE AREAS IN SQUARE MILES. METERS GIVE AREAS IN SO 
UARE METERS AND LENGTHS IN KILOMETERS GIVE AREAS IN SQUARE KILOMETERS." 

380 PRINT:GOSUB15000 

381 W=0 

382 CLS:PRINT6331,"IF SIDE (A) IS 12 INCHES AND SIDE (B) IS 15 INCHES WHAT IS 

THE AREA OF THIS RECTANGLE?" 
384 PRINT:GOSUB 15000 

386 CLS:PRINT@334,"180 SQUARE FEET TYPE 1" 

388 PRINTTABU4) "150 SQUARE INCHES TYPE 2" 

390 PRINTTABU4) "180 SQUARE INCHES TYPE 3" 

392 PRINTTAB(14) "150 SQUARE FEET TYPE 4" 

394 GOSUB10000 

396 IF A<1 OR A>4 THEN GOTO 386 

398 IF A=3 THEN GOTO 402 

400 W=W+l:PRINTTAB(22)"SORRY, THAT IS WRONG" : IFWOTHEN PRINTTAB ( 28 ) "TRY AGAIN"-P 

ORX=1TO500 : NEXT: GOT03 86 

401 IFW=3 THEN PRINTTAB) 14 ) "THE CORRECT ANSWER IS 180 SQ. INCHES" : PRINTTAB ( 24 )»n 

ORE STUDY NEEDED":FORX=1TO2000:NEXT:GOTO200 

402 PRINT:PRINTTAB(29) "CORRECT 

":FORX=1TO500:NEXT 

405 CLS:W=0 

406 PRINT«99,"HOW MANY SIDES DOES A RECTANGLE HAVE?" : PRINT: PRINT 
408 GOSUB15000 

410 CLS :PRINTH34, "THREE SIDES TYPE 1" 

412 PRINTTAB(14)"FIVE SIDES TYPE 2" 

414 PRINTTABU4) "SIX SIDES TYPE 3" 

416 PRINTTAB (14) "FOUR SIDES TYPE 4" 

418 GOSUB10000 

420 IFA<1 OR A>4 THEN GOTO 410 

422 IF A=4THEN GOTO 432 

424 W=W+1:PRINT:PRINTTAB(22) "SORRY, THAT IS WRONG" 

426 IFW<3THENPRINTTAB(28)"TRY AGAIN" :FORX=1TO500 :NEXT:GOTO410 

428 IFW=3THENPRINTTAB(16)"THE CORRECT ANSWER IS FOUR SIDES" :PRINTTAB ( 24) "BACK TO 

STUDYING" :FORX=1TO2000: NEXT: GOTO200 
432 PRINTTAB(29) "CORRECT" :FORX=1TO500 :NEXT 

499 W=0 

500 CLS:PRINT@332,"A CITY LOT HAS A 60 FOOT STREET FRONTAGE AND A DEPTHOF 100 vi 

RDS. WHAT IS THE AREA IN SQUARE YARDS?" :PRINT 

501 GOSUB15000 

502 CLS:PRINT6333,"6000 SQUARE YARDS TYPE 1" 

503 PRINTTAB(13)"2000 SQUARE YARDS TYPE 2" 

504 PRINTTAB(13)"1998 SQUARE YARDS TYPE 3" 

505 PRINTTABU3) "666 SQUARE YARDS TYPE 4" 

506 GOSUB10000 

507 IFA<1 OR A>4 THEN GOTO 502 

508 IF A=2 THEN GOTO 530 

510 W=W+1: PRINT: PRINTTAB (22) "SORRY, THAT IS WRONG" 

515 IFWOTHEN PRINTTAB ( 28 ) "TRY AGAIN" :FORX=1TO500 :NEXT:GOTO502 

520 IFW=3THEN PRINTTAB) 16) "THE CORRECT ANSWER IS 2000 SQ. YARDS" :PRINTTAB ( 24 ) »BA 

CK TO STUDYING" :FORX=1TO2000:NEXT:GOTO200 
530 PRINTTAB (29) "CORRECT" :FORX=1TO500: NEXT: GOTO40 
600 CLS :PRINT8343, "WHAT IS A CIRCLE?" : FORX=1TO500 :NEXT: PRINT 
610 PRINTTAB(6) "A CIRCLE IS A PLANE FIGURE BOUNDED BY AN ENDLESS, CURVING LINE 

EVERY POINT OF WHICH IS EQUAL DISTANT FROM A COMMON POINT CALLED THE CENTER 

620 GOSUB15000 
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630 CLS:PRINT624, "PARTS OF A CIRCLE":FORX=1TO500:NEXT 

640 PRINTTAB (6) "THE LENGTH OF ONE COMPLETE CIRCUIT ON THE BOUNDING LINE OFA CIRC 

LE IS CALLED THE CIRCUMFERENCE OF THE CIRCLE." 
658 PRINTTAB(6)"ALL CIRCLES HAVE A POINT CALLED THE CENTER OF THE CIRCLE. THE C 

ENTER IS EQUAL DISTANCE FROM ALL POINTS ON THE BOUNDINGLINE" 
66fl PRIMTTAB(6) "THE DISTANCE FROM THE CENTER TO ANY POINT ON THE BOUNDING LINE I 

S CALLED THE RADIUS OF THE CIRCLE." 
670 PRINTTAB(6)"THE DISTANCE FROM ANY POINT ON THE BOUNDING LINE, THROUGHTHE CE 

HTER AND TO THE POINT DIRECTLY OPPOSITE ON THE BOUNDINGLINE IS CALLED TH 

E DIAMETER OF THE CIRCLE. IT IS EQUAL TO TWICETHE RADIUS." 
680 PRINTTAB(6) "THE SPACE ENCLOSED BY THE BOUNDING LINE IS CALLED THE AREAOF THE 

CIRCLE." 
690 GOSUB15000 
790 CLS:PRINT@393,"THE AREA OF A CIRCLE IS EQUAL TO THE DIAMETER TIMES THEDIAMET 

ER TIMES ONE-FOURTH OF PI (0.7854) OR , MORE COMMONLYEXPRESSED AS DIAM 

ETER SQUARED TIMES 0.7854" 
795 PRINT:GOSUB15000 

799 W=0 

800 CLS:PRINT(S328,"A CIRCLE HAS A RADIUS OF 3 FEET, WHAT IS ITS AREA?" 

801 PRINT: PRINTTAB(18) "7.06 86 SQ. FT TYPE 1" 

802 PRINTTAB (18) "14.1372 SQ. FT TYPE 2" 

803 PRINTTAB(18) "28.1944 SQ. FT TYPE 3" 

804 PRINTTAB(18) "21.2058 SQ. FT TYPE 4" 

805 GOSUB10000 

806 IFA<1 OR A>4 THEN GOTO 800 
810 IF A=3 THEN GOTO 835 

815 W=W+1:PRINT:PRINTTAB(22) "SORRY, THAT IS WRONG" 

820 IFW<3 THEN PRINTTAB(28) "TRY AGAIN" : FORX=1TO500:NEXT 

825 IFW=3 THEN GOTO 830 ELSE 800 

830 PRINT:PRINTTAB(14)"THE CORRECT ANSWER IS 28.1944 SQ. FT. " :PRINTTAB(25) "STUDY 

SOME MORE":FORX=1TO2000:NEXT:GOTO600 
835 PRINT : PRINTTAB ( 29 ) "CORRECT" : FORX=1TO500 : NEXT 
930 W=0 

940 CLS:PRINTM51, "LET'S TRY ONE MORE" 
945 PRINT:PRINTTAB(12)"A CIRCLE 5 FEET IN DIAMETER HAS AN AREA OF" 

950 PRINT: PRINTTAB (15) "19.635 SQUARE INCHES TYPE 1" 

960 PRINTTABU5) "19.745 SQUARE FEET TYPE 2" 

970 PRINT TAB(15) "24.215 SQUARE FEET TYPE 3" 

980 PRINT TAB(15) "19.635 SQUARE FEET TYPE 4" 

990 GOSUB10000 

991 IF A<1 OR A>4 THEN GOTO940 

992 IF A=4 THEN GOTO 999 

993 W=W+1: PRINT: PRINTTAB(22) "SORRY, THAT IS WRONG" 

994 IF W<3 THEN PRINTTAB (28) "TRY AGAIN" :FORX=1TO500:NEXT 

995 IF W=3 THEN GOTO 996 ELSE 940 

996 PRINT: PRINTTAB (14) "THE CORRECT ANSWER IS 19.635 SQ. FT. ": PRINTTAB! 24) "MORE S 

TUDY NEEDED" :FORX=1TO2000:NEXT: GOTO600 
999 PRINT:PRINTTAB(29)"CORRECT":FORX=1TO500: NEXT:GOTO40 
2000 CLS:PRINT6407,"WHAT IS A TRIANGLE?" 
2010 FORX=1TO200:NEXT 
2020 PRINT:PRINTTAB(10)"A TRIANGLE IS A PLANE FIGURE BOUNDED BY THREE STRAIGHTLI 

NES AND ENCLOSING THREE ANGLES." 
2030 PRINT:GOSUB15000 

2040 CLS:PRINTi86, "PARTS OF A TRIANGLE" 
2050 PRINT: PRINTTAB (5) "A TRIANGLE HAS THREE (3) SIDES, EACH OF WHICH IS A STRAIG 

HTLINE." 
2060 PRINT:PRINTTAB(5)"A TRIANGLE CONTAINS THREE (3) ANGLES, THE SUM OF WHI 

CHALWAYS EQUALS 180 DEGREES." 
2070 PRINT:PRINTTAB(5)"THE SPACE ENCLOSED BY THE SIDES OF A TRIANGLE IS CALLED T 

HEAREA OF THE TRIANGLE. WE ARE INTERESTED IN THIS PART OF THETRIANGLE" 

2080 PRINT:GOSUB15000 
2090 CLS:PRINT@95,"APEX" 
2092 PRINT§351,"H" 

2095 X=66:FORY=8T023STEP2:SET(X,Y) :NEXT 
2100 X=51:Y=23:K=15:FORL=0TOK:SET(X+L,Y-L) :HEXT 
2110 X=66:Y=8:K=15:FORL=0TOK:SET(X+L,Y+L) :NEXT 
2120 Y=23:FORX=52TO80:SET(X,Y) :NEXT 
2130 PRINT8542,"BASE (A)" 
2140 PRINTTAB (28) "A TRIANGLE" 
2150 PRINT:PRINTTAB(32)"(A) X (H)" 

2160 PRINTTAB(25)"AREA = " 

2170 PRINTTAB(36) "2" 

217 3 GOSUB15000 

2174 CLS:PRINT6133, "KNOWING THE LENGTH OF THE BASE AND THE ALTITUDE IT ISP 

OSSIBLE TO FIND THE AREA OF THE TRIANGLE." 

2176 PRINT:PRINTTAB(5)"THE AREA IS EQUAL TO HALF OF THE BASE TIMES THE ALTITUD 
E, OR, (A) THE BASE TIMES (H) THE ALTITUDE DIVIDED BY 2." 

2177 PRINT:PRINTTAB(5) "THEREFORE, A TRIANGLE WITH A BASE OF 12 INCHES AND A 
N ALUITUDE OF 24 INCHES WOULD HAVE AN AREA OF -" 

2178 PRINT:PRINTTAB(22)"12 X 24" 

2180 PRINTTAB (14) "AREA IS = 144 SQUARE INCHES" 

2182 PRINTTAB (25) "2" 

2184 GOSUB15000 

2186 W=0 

2190 CLS:PRINT8208,"A TRIANGLE HAS HOW MANY OF THESE?" 

2200 PRINT:PRINTTAB(15) "THREE SIDES TYPE 1 
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2210 PRINTTABI 15) "THREE ANGLES TYPE 2 

2220 PRINTTABU5) "A BASE TYPE 3 

2230 PRINTTABU5) "AN APEX TYPE 4 

2240 PRINTTABI15) "AN ALTITUDE TYPE 5 

2250 PRINTTABI 15) "ALL OF THE ABOVE TYPE 6 

2260 PRINT: PRINTTABI 11) "TYPE 1, 2, 3, 4 , 5 OR 6 THEN PRESS (ENTER)" 

2262 GOSUB10010 

2265 IF A<1 OR A>6 THEN GOTO2190 

2270 IF A=6 THEN GOTO 2295 

2275 W=W+1:PRINT:PRINTTAB(22) "SORRY, YOU ARE WRONG" 

2280 IF W<3 THEN PRINTTAB(28) "TRY AGAIN" :FORX=1TO500 :NEXT 

2285 IFW=3 THEN GOTO2290 ELSE 2190 

2290 PRINT: PRINTTABI 14) "THE CORRECT ANSWER IS ALL OF THE ABOVE" :PRINTTAB(24 ) "MOR 

E STUDY NEEDED":FORX=1TO2000:NEXT:GOTO2000 
2295 PRINT:PRINTTAB(29) "CORRECT" :FORX=1TO500:NEXT 
2300 W=0 
2400 CLS:PRINT8395, "GIVEN A TRIANGLE WITH A BASE MEASURING 15 FEET AND ANALTITUD 

E OF 20 FEET WHAT IS THE AREA OF THE TRIANGLE?" 
2410 PRINT:GOSUB15000 

2420 CLS:PRINT8269,"300 SQUARE FEET TYPE 1 

2430 PRINTTAB(13)"300 FEET TYPE 2 

2440 PRINTTAB(13)"150 SQUARE INCHES TYPE 3 

2450 PRINTTAB(13)"150 SQUARE FEET TYPE 4 

2460 GOSUB10000 

2465 IFA<1 OR A>4 THEN GOTO2420 

2470 IF A=4 THEN GOTO 2495 

2475 W=W+1:PRINT:PRINTTAB(22) "SORRY, THAT IS WRONG" 

2480 IFW<3 THEN PRINTTABI 28) "TRY AGAIN" :FORX=1TO500 :NEXT 

2485 IFW=3 THEN GOTO2490 ELSE2420 

2490 PRINT:PRINTTAB(16)"THE CORRECT ANSWER IS 150 SQ. FT. " :PRINTTAB (24) "MORE STU 

DY NEEDED":FORX=1TO2000:NEXT:GOTO 2000 
2495 PRINT:PRINTTAB(29) "CORRECT": FORX=1TO500 :NEXT:GOTO40 
3000 CLS 
3010 PRINT8327,"A FARMER'S FIELD IS ONE THOUSAND (1000) FEET LONG AND ONE HUN 

DRED EIGHTY FIVE (185) FEET WIDE." 
3020 PRINT:PRINTTAB(17) "WHAT IS THE AREA OF THIS FIELD?" 
3030 R=0:W=0 
3040 PRINT:GOSUB15000 

3050 CLS:PRINT6334, "18500 SQUARE FEET TYPE 1" 

3060 PRINTTAB(14) "185000 SQUARE INCHES TYPE 2" 

3070 PRINTTABI14) "185000 SQUARE FEET TYPE 3" 

3080 PRINTTAB(14) "185000 FEET TYPE 4" 

3090 GOSUB10000 

3092 IFA<1 OR A>4THENGOTO305B 

3095 IF A=3THENGOSUB5000ELSEGOSUB5010 

3100 CLS:PRINT(?391,"A CIRCLE TEN (10) FEET IN DIAMETER HAS AN AREA OP ?" 

3120 PRINT:GOSUB15000 

3130 CLS:PRINT§332,"78.54 SQUARE FEET TYPE 1" 

3140 PRINTTAB(12)"7854 SQUARE FEET TYPE 2" 

3150 PRINTTAB(12)"785.4 SQUARE FEET TYPE 3" 

3160 PRINTTABU2) ".7854 SQUARE FEET TYPE 4" 

3170 GOSUB10000 

3175 IF A<1 OR A>4THENGOTO3130 

3180 IFA=1THENGOSUB5000ELSEGOSUB5010 

3190 CLS:PRINT8197,"THE AREA OF A TRIANGLE IS EQUAL TO WHICH OF THE FOLLOWING?" 

3200 PRINT:PRINTTAB(12)"(D) X (D) X 0.7854 TYPE 1" 

3210 PRINTTAB(12)"(A X H) / 2 TYPE 2" 

3220 PRINTTAB(12)"(A) X (H) TYPE 3" 

3230 PRINTTAB(12)"(A) X (B) TYPE 4" 

3250 GOSUB10000 

3255 IF A<1 OR A>4THENGOTO3190 

3260 IFA=2THENGOSUB5000ELSEGOSUB5010 

3270 CLS:PRINT8389,"A SAILBOAT NEEDS A NEW SAIL. tHE BOOM (BASE) IS TWENTY-FOUR! 
24) FEET LONG AND THE MAST (ALTITUDE) IS THIRTY-SIX (36) FEETHIGH. HOW M 
UCH CANVAS WILL BE NEEDED?" 

3280 PRINT:GOSUB15000 

3290 CLS:PRINT6334,"864 SQUARE FEET TYPE 1" 

3300 PRINTTAB(14)"1728 SQUARE FEET TYPE 2"" 

3310 PRINTTABI 14) "432 SQUARE FEET TYPE 3" 

3320 PRINTTAB(14)"216 SQUARE FEET TYPE 4" 

3330 GOSUB10000 

3335 IF A<1 OR A>4THENGOTO3290 

3340 IFA=3THENGOSUB5000ELSEGOSUB5010 

3350 CLS:PRINTS204,"THE AREA OF A CIRCLE IS FOUND AS FOLLOWS" 

3360 PRINT:PRINTTAB(12)"(A) X (B) TYPE 1" 

3370 PRINTTAB(12)"(A X H) / 2 TYPE 2" 

3380 PRINTTAB(12)"(A) X (B) X 0.7854 TYPE 3" 

3390 PRINTTAB(12)"(D) X (D) X 0.7854 TYPE 4" 

3410 GOSUB10000 

3415 IFA<1 OR A>4THENGOTO3350 

3420 IFA=4THENGOSUB5000ELSEGOSUB5010 

3430 CLS:PRINT6389,"A MERRY-GO-ROUND IS FIFTY (50) FEET IN DIAMETER, ADDINGA 
NOTHER TEN (10) FEET ALL AROUND, WHAT IS THE AREA THAT WILLHAVE TO BE C 
LEARED TO SET UP THE MERRY-GO-ROUND? 

3440 PRINT:GOSUB15000 

3450 CLS:PRINTe334,"3848.46 SQUARE FEET TYPE 1" 

3460 PRINTTABI14) "3600.00 SQUARE FEET TYPE 2" 
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3470 PRINTTABU4) "2827.44 SQUARE FEET TYPE 3" 

3480 PRINTTAB(14) "4900.00 SQUARE FEET TYPE 4" 

3490 GOSUB10000 

3495 IFA<1 ORA>4THENGOTO3450 

3500 IF A=1THENGOSUB5000ELSEGOSUB5010 

3510 CLS:PRINT8265,"A TRIANGULAR FIELD TWO HUNDRED (200) FEET ON ONE SIDE (BASE 

) AND THREE HUNDRED (300) FEET IN ALTITUDEIS TO BE SEEDED FOR A LAWN." 
3520 PRINT:PRINTTAB(9)"ONE POUND WILL SEED TWO HUNDRED (200) SQUARE FEET. HOWHU 

CH SEED SHOULD YOU BUY?" 
3530 PRINT :GOSUB15 000 

3540 CLS:PRINTS334, "300 POUNDS TYPE 1" 

3550 PRINTTAB(14)"150 POUNDS TYPE 2" 

3560 PRINTTAB(14)"800 POUNDS TYPE 3" 

3570 PRINTTAB(14) "600 POUNDS TYPE 4" 

3580 GOSUB10000 

3585 IF A<1 OR A>4 THENGOTO3540 

3590 IFA=2THENGOSUB5000ELSEGOSUB5010 

3600 CLS:PRINT6203,"THE AREA OF A RECTANGLE IS FOUND AS FOLLOWS" 

3640 PRINT:PRINTTAB(13)"(D) X (D) X 0.7854 TYPE 1" 

3650 PRINTTABU3) "(A X H) / 2 TYPE 2" 

3660 PRINTTABU3) "(A) X (H) TYPE 3" 

3670 PRINTTAB(13) "(A) X (B) TYPE 4" 

3680 GOSUB10000 

3685 IF A<1 OR A>4 THENGOTO3600 
3690 IF A=4THENGOSUB5000ELSEGOSUB5010 

3700 CLS:PRINTe391,"A NEIGHBOR WANTS YOU TO MOW HIS LAWN. THE YARD MEASURES100 
BY 200 FEET AND THE HOUSE COVERS 36 BY 50 FEET. HOW MUCHAREA IS THERE 

TO BE MOWED?" 
3710 PRINT:GOSUB15000 

3720 CLS:PRINT6334, "20000 SQUARE FEET TYPE 1" 

3730 PRINTTAB(14)"1800 SQUARE FEET TYPE 2" 

3740 PRINTTABU4) "21800 SQUARE FEET TYPE 3" 

3750 PRINTTAB(14) "18200 SQUARE FEET TYPE 4" 

3760 GOSUB10000 

3765 IFA<1 OR A>4THENGOTO3720 

3770 IFA=4THENGOSUB5000ELSEGOSUB5010 

3780 CLS:PRINT8333,"HOW MANY SQUARE YARDS OF CARPETING WILL BE REQUIRED FOR WALL 

TO WALL COVERAGE IN A ROOM THAT MEASURES 12 FEET BY 24 FEET?" 
3790 PRINT:GOSUB15000 

3800 CLS:PRINT§334,"96 SQUARE YARDS TYPE 1" 

3810 PRINTTAB(14) "32 SQUARE YARDS TYPE 2" 

3820 PRINTTAB(14)"24 SQUARE YARDS TYPE 3" 

3830 PRINTTAB(14)"72 SQUARE YARDS TYPE 4" 

3840 GOSUB10000 

3845 IF A<1 OR A>4THENGOTO3800 

3850 IFA=2THENGOSUB5000ELSEGOSUB5010 

3900 GOTO5900 

5000 PRINT: PRINTTAB( 29) "CORRECT" :R=R+1:FORX=1TO500: NEXT: GOTO5020 

5010 PRINT:PRINTTAB(23)"SORRY, THAT IS WRONG" :W=W+1 : FORX=1TO500 :NEXT 

5020 CLS:PRINT6402,"YOU HAVE ";R;" RIGHT, AND ";W;" WRONG" :FORX=1TO750:NEXT:RETU 

RN 
5900 G=R*10 

5910 CLS:PRINT6406,"YOUR GRADE IS ";Gi" %" 

5915 IF G=>70 THEN PRINTTAB(25) "CONGRATULATIONS" :FORX=1TO2000:NEXT:END 
5917 IF G<70 THENPRINTTAB(24) "SORRY, TRY AGAIN" 
5920 FORX=1TO2000:NEXT:GOTO200 

9999 GOT09999 

10000 PRINT:PRINTTAB(13) "TYPE 1, 2, 3 OR 4 THEN PRESS (ENTER)" 
10010 PRINTTAB(22)"YOUR ANSWER. PLEASE" ; : INPUTA: RETURN 

15000 PRINTTAB( 20) "PRESS (ENTER) TO CONTINUE" : INPUT:RETURN 
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STATES: by Robert F. Nichol 



A good drill on your knowl- 
edge of the fifty states. Capitals, 
largest cities, populations, 
nicknames and alphabetical 
order routines are all included. 
An excellent educational exercise 
for grade school Geography and 
American History classes. Say, 
which state is known as the 
Granite State? 



MENU: 

1 - INFORMATION FOR A STATE 
g - ALPHABETICAL ORDER 

3 - STATES AND CAPITALS 

4 - STATES AND LARGEST CITIES 

5 - STATES AND POPULAR NAMES 

6 - STATES AND POPULATIONS 

CM' TO RETURN TO THIS MENU) 
ENTER NUMBER OF YOUR CHOICE? _ 



IBB CLS:RANDOM:CLEAR1BB:DIMS$(5B),S(5B),C$(5B),L$(50),P(50),PAS(50),PB$(50> 

llfl N=5B 

115 DEPDBLP:DIMP(50) 

12B FORX=lTON:READS$(X),C$(X),LS(X),P(X),PA$(X),PB$(X):NEXT X 

5BB CLS:PRINTCHR$(23) 

51B PRINT864,"M E N U :": PRINT 

52B PRINT" 1 - INFORMATION FOR A STATE 

53B PRINT" 2 - ALPHABETICAL ORDER 

54B PRINT" 3 - STATES AND CAPITALS 

55B PRINT" 4 - STATES AND LARGEST CITIES 

56B PRINT" 5 - STATES AND POPULAR NAMES 

570 PRINT" 6 - STATES AND POPULATIONS 

580 PRim^PRINT'CM' TO RETURN TO THIS MENU) 

598 PRINT: INPUT"ENTER NUMBER OF YOUR CHOICE", -CH 

6B0 IFCH<1 OR CH>6 THEN500 

610 ON CH GOTO 10BB, 3BBB, 50B0, 7000, 90BB, 11000 

1000 REM PRINT INFORMATION FOR A SPECIFIC STATE 

1010 CLS:PRINTCHR$(23) 

1B2B PRINT"ENTER NAME OF STATE":PRINT:INPUT" ",-SS 

1B3B IFSS="M" THEN 5B0 

104B FOR X=1T0N 

1050 IF SS(X)=S$ THEN 1100 

1060 NEXT X 

1070 PRINT:PRINT:PRINTS$;" IS NOT A STATE" : PRINT: PRINT" IN THE UNITED STATES!" 

1080 FOR TI*1TO750: NEXT TI: GOTO101B 

1100 CLS:PRINT80,CHR$(23); 

111B PRINT'STATE - ";S$(X) 

112B PRINT: PRINT"CAPITAL - ";C$(X) 

1130 PRINT: PRINT'LARGEST CITY - ";L$(X) 

1140 PRINT: PRINT'POPULATION (1970) - ";:PRINT USING "####»,###*"; P(X) 

115B IF PB$(X)<>"?" THEN 117B 

1160 PRINT: PRINT'POPULAR NAME: ":PRINT:PRINT" 

1170 PRINT:PRINT"POPULAR NAMES: " :PRINT:PRINT" 

118B PRINT:PRINT" "iPB$(X) 

1200 PRINT:PRINT:INPUT"HIT ENTER TO CONTINUE" ;EN:GOTO1010 

300B REM ENTER STATES IN ALPHABETICAL ORDER 

301B W=0:CLS:PRINT60,CHR$(23) .-"STATES IN ALPHABETICAL ORDER" 

3B15 PRINT:PRINT"NAME OF FIRST STATE"; : INPUTS? :IFS$=S$ (1) THEN 3020 ELSE PRINT"WR 

ONG, ALABAMA IS FIRST I " :W=W+1 
3020 FOR X=2TON 

3B30 PRINT: INPUT"NEXT STATE";S$ 
3035 IF S$="M" THEN 500 
3B40 IFS$=S$(X) THEN 3B6B 

3B50 W=W+l:PRINT"WRONG, ";S$(X);" IS NEXT!" 
3060 NEXT X:PRINTSTRING?(32,131) ; 
3070 PRINT: PRINT"RIGHT ="jN-W;" WRONG =" ;W; : PRINT: PRINT:PRINT"SCORE =";:PRINT US 

ING"## t.#t", -100* (N-Wl/N;: PRINT" %" 
3080 PRINT: PRINT: INPUT"HIT ENTER TO RETURN TO MENU"; EN: GOTO 5BB 
5B00 REM STATES AND THEIR CAPITALS 
5010 FORX=1TO50: S(X)=0: NEXT X 
5B20 R=B: W=B 

5030 CLS: PRINT§0,CHR$(23); 

5040 INPUT"HOW MANY QUESTIONS (1-50) ";Q:IFQ<1ORQ>50 THEN 5030 
5050 CLS 

5060 PRINTS, CHR$ (23) ;"M E N U : 
5B70 PRINT:PRINT" 1 - GIVE CAPITAL 



,-PA$(X) :GOTO1200 
";PA$(X) 
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5080 PRINT:PRINT" 2 - GIVE STATE 

5090 PRINT:PRINT" 3 - MIXED 

5100 PRINT: PRINT: INPUT-ENTER NUMBER OF YOUR CHOICE"; SC: IP SC<1 OR SC>3 THEN505 


5110 ON SC GOTO5120, 5500, 5800 
5120 FOR X=1T0Q: CLS: PRINT8128,CHRS (23) ; 
5130 S=RND(N): IP S(S)=1 THEN 5130 

5150 S(S)=1:PRINT"WHAT IS THE CAPITAL OF" : PRINT: PRINT" ";S$(S) 
5160 PRINT:INPOT" ";C$:PRINT 
5165 IF C$="M" THEN 5205 

5170 IF C$=CS(S) THEN R=R+1: PRINT "CORRECT I " :GOTO5200 

5180 W=W+1: PRINT"WRONG...";C?(S):PRINT:PRINT"IS THE CAPITAL OF ";S$(S1 
5200 IF SC = 3 THEN 5850 ELSE IFX<QTHENPRINT: INPUT'HIT ENTER TO CONTINUE" JEN: NE 

XT 
5205 PRINT: PRINT"RIGHT =",-R; "WRONG =";W 

5210 PRINT: PRINT"SCORE = "; :PRINTUSING"»S.8S" ;100*(R/(R+W+. 000001) ); :PRINT" %" 
5220 PRINT:PRINT:INPUT"HIT ENTER TO CONTINUE"; EN: GOTO500 
5500 FOR X-1TOQ: CLS: PRINTS128,CHR$ (23) ; 
5510 S=RND(N): IF S(S)=1 THEN 5510 
5520 S(S)=1:PRINTC$(S);" IS THE CAPITAL OF 
5530 PRINT:INPUT" ";SS:PRINT 
5540 IFS$="M"THEN5610 

5550 IFS$=S$(S) THEN R=R+1: PRINT"CORRECTI " : GOTO 5600 

5560 W=W+1: PRINT"WRONG...";C$(S):PRINT:PRINT"IS THE CAPITAL OF ";S$(S> 
5600 IF SC=3 THEN 5850 ELSE IF X<Q THEN PRINT: INPUT"HIT ENTER TO CONTINUE";EN: 

NEXT 
5610 GOTO5205 

5800 FOR X=1T0Q: CLS: PRINT6128 ,CHR$ (23) ; 
5810 S=RND(N) :IFS(S)=1 THEN 5810 
5820 M=RND(2) 
5830 ON M GOTO 5150, 5520 

5850 IF X<Q THEN PRINT: INPUT"HIT ENTER TO CONTINUE" , -EN: NEXT 
5860 GOTO 5205 

7000 REM STATES AND LARGEST CITIES 
7010 FOR X=1TO50: S(X)=0: NEXT X 
7020 R=0: W=0 

7030 CLS: PRINT60,CHR?(23) ; 

7040 INPUT"HOW MANY QUESTIONS (1-50) ";Q: IF Q<1 OR Q>50 THEN 7030 
7050 CLS 

7060 PRINT@64,CHR$(23) ;"M E N U : 
7070 PRINT:PRINT" 1 - GIVE LARGEST CITY 
7080 PRINT: PRINT" 2 - GIVE STATE 
7090 PRINT: PRINT" 3 - MIXED 
7100 PRINT: PRINT: INPUT'ENTER NUMBER OF YOUR CHOICE" ;SC: IF SC<1 OR SC>3 THEN 705 


7110 ON SC GOTO 7120, 7500, 7800 
7120 FOR X=1T0Q: CLS: PRINT8128 ,CHR$ (23) ; 
7130 S=RND(N): IF S(S)=1 THEN 7130 

7150 S(S)=1: PRINT"WHAT IS THE LARGEST CITY IN" : PRINT: PRINT" ";S$(S) 
7155 FS=L$ (S) : IFSS (S) ="MAINE"ORSS (S) ="OREGON"THENF$=LEFT$ (LS (S) , 8) 
7160 PRINT:INPUT" ";LS:PRINT 
7170 IFL$="M" THEN 7205 

7180 IF LS=FS THEN R=R+1: PRINT"CORRECTl " : GOTO 7200 

7190 W=W+1: PRINT"WRONG...";LS(S):PRINT"IS THE LARGEST CITY IN ":PRINTS$(S) 
7200 IF SC=3 THEN 7 840 ELSE IFX<QTHENPRINT: INPUT'HIT ENTER TO CONTINUE" ; EN : NEXT 
7205 GOTO 5205 

7500 FOR X=1T0Q: CLS: PRINT9128 ,CHR$ (23) ; 
7510 S=RND(N): IF S(S)=1 THEN 7510 

7520 S(S)=1: PRINTLS(S) :PRINT:PRINT"IS THE LARGEST CITY IN 
7530 PRINT:INPUT" ";S?:PRINT 
7540 IF SS="M" THEN 7580 

7550 IF SS=SS(S) THEN R=R+1: PRINT"CORRECTI " : GOTO 7570 

7560 W=W+1: PRINT"WRONG...";LS(S) :PRINT"IS THE LARGEST CITY IN ":PRINTS$(S) 
7570 IF SC=3 THEN 7840 ELSE IF X<Q THEN PRINT: INPUT"HIT ENTER TO CONTINUE", -EN: N 

EXT 
7580 GOTO 5205 

7800 FOR X=1T0Q: CLS: PRINT6128 ,CHR$ (23) ; 
7810 S=RND(N): IF S(S)=1 THEN 7810 
7820 M=RND(2) 
7830 ON M GOTO 7150, 7520 

7840 IF X<Q THEN PRINT: INPUT"HIT ENTER TO CONTINUE" ; EN: NEXT 
7850 GOTO5205 

9000 REM STATES AND POPULAR NAMES 
9010 R=0:W=0:CLS:PRINT60,CHRS(23) ; 
9015 FORX=1TON:S(X)=0:NEXT 

9020 INPUT"HOW MANY QUESTIONS (1-50) " ;Q: IFQ<1 OR Q>50 THEN9010 
9030 CLS: PRINT864,CHRS(23);"M E N U : 
9040 PRINT: PRINT" 1 - GIVE POPULAR NAME 
9050 PRINT: PRINT" 2 - GIVE STATE 
9060 PRINT: PRINT" 3 - MIXED 

9070 PRINT: PRINT :INPUT"ENTER NUMBER OF YOUR CHOICE";SC: IF SC<1 OR SC>3 THEN9030 
9080 ON SC GOTO 9500, 9120, 9800 
9120 FORX=lTOQ: CLS: PRINT80,CHR$ (23) ; 
9130 S=RND(N): IF S(S)=1 THEN 9130 
9150 S(S)=1 

9160 PRINT"WHAT STATE IS KNOWN AS" :PRINT: PRINT" ";PA5(S) 
9170 IFPB$(S)="?"THEN9180 ELSE PRINT:PRINT" OR ";PB$(S) 
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9180 PRINT: INPUTS? 

9190 IFSS="M"THEN 5205 

9200 IFS$ = S$(S)THENR=R+1: PRINT: PRINT"C0RRECT1 " :GOTO9220 

9210 W=W+1:PRINT:PRINT"WR0NG...THE ANSWER IS " :PRINT:PRINTSS (S) 

9220 PRINT:IF SC=3 THEN9840 ELSE IP X<Q THEN INPUT"HIT ENTER TO CONTINUE" ;EN: NE 

XT 
9230 GOTOS205 

9500 FORX=lTOQ: CLS: PRINT80 ,CHR$ (23 ) ; 
9510 S=RND(N): IF S(S)=1 THEN 9510 
9520 S(S)=1 

9530 PRINT"WHAT IS THE NICKNAME OF 
9540 PRINT : PRINTS$ (S) ; : INPUTP? 
9550 IFPS = "M"THEN5205 

9560 IFP$=PA$(S)ORP$=PB$(S)THENR=R+l: PRINT: PR I NT" CORRECT 1 " : GOTO9590 
9570 W=W+l:PRINT:PRINT"WRONG...";S?(S) :PRINT"IS KNOWN AS 
9580 PRINT:PRINT" " ,-PAS (S) : IFPB$ (S) <>"?"THENPRINT" OR °;PBS(S) 
9590 PRINT: IFSC=3THEN9840 ELSE IF X<Q THEN INPUT"HIT ENTER TO CONTINUE" , -EN: NEXT 
9600 GOTO5 205 

9800 FORX=lTOQ:CLS: PRINT80 ,CHR$ ( 23) ; 
9810 S=RND(N): IFS(S)=1 THEN 9810 
9820 H=RND(2) 
9830 ON M GOTO 9150, 9520 

9840 PRINT: IFX<QTHENINPUT"HIT ENTER TO CONTINUE" ;EN:NEXT 
9850 GOTO5205 

11000 REM STATES AND POPULATIONS 
11010 FORX=1TO50: S(X)=0: NEXT X 
11020 R=0: W=0 
11030 CLS: PRINie0,CHRS(23) ; 

11040 INPUT"WHAT PERCENT ACCURACY (1-50) " ; A: IFA<1ORA>50 THEN11030 
11050 CLS:PRINT80,CHR$(23); 

11060 1NPUT"H0W MANY QUESTIONS (1-50) " jQ: IFQ<1 OR Q>50 THEN 11050 
11070 CLS 

11080 FORX=lTOQ:CLSjPRINT60,CHR5(23) 
11090 S=RND(N): IF S(S)=1 THEN 11090 
11100 S(S)*1 

11110 PRINT"WHAT IS THE POPULATION OF 

11120 PRINT:PRINTSS(S);: INPUT" ";PS:IFP$="M"THEN 5205 
11125 P=VAL(P$) 
11130 IFP>P(S)-P(S)*A/100 AND P< P(S) +P(S) *A/100 THEN R=R+1: PRINT: PRINT "RIGHT I 

POPOLATION IS ";:PRINTUSING"###,##«SS#";P(S) :GOTO11150 
11140 W=W+l:PRINT:PRINT"WRONGI POPULATION IS "; :PRINTUSING"###, »*####" ;P(S) 
11150 PRINT:PRINT"YOU WERE OFF BY " ; :PRINTUSING"#,#*I. »#";ABS(100-100*P/(P(S) +.0 

00001) );:PRINT" %" 
11200 PRINT:IF X<Q THEN INPUT"HIT ENTER TO CONTINUE" J EN: NEXT 
11210 GOTO5205 

15000 REM DATA STATEMENTS FOR STATE INFORMATION 
15010 DATA ALABAMA, MONTGOMERY, BIRMINGHAM, 3444165, HEART OF DIXIE, COTTON STAT 

E 
15020 DATA ALASKA, JUNEAU, ANCHORAGE, 30217 3, GREAT LAND, 7 
15030 DATA ARIZONA, PHOENIX, PHOENIX, 1772482, GRAND CANYON STATE, 7 
15040 DATA ARKANSAS, LITTLE ROCK, LITTLE ROCK, 1923295, LAND OF OPPORTUNITY, WON 

DER STATE 
15050 DATA CALIFORNIA, SACRAMENTO, LOS ANGELES, 19953134, GOLDEN STATE, ? 
15060 DATA COLORADO, DENVER, DENVER, 2207259, CENTENNIAL STATE, 7 
15070 DATA CONNECTICUT, HARTFORD, HARTFORD, 3032217, CONSTITUTION STATE, NUTMEG 

STATE 
15080 DATA DELAWARE, DOVER, WILMINGTON, 548104, FIRST STATE, DIAMOND STATE 
15090 DATA FLORIDA, TALLAHASSEE, JACKSONVILLE, 6789443, SUNSHINE STATE, PENINSUL 

A STATE 
15100 DATA GEORGIA, ATLANTA, ATLANTA, 4589575, EMPIRE STATE OF THE SOUTH, 7 
15110 DATA HAWAII, HONOLULU, HONOLULU, 769913, ALOHA STATE, PARADISE OF THE PACI 

FIC 
15120 DATA IDAHO, BOISE, BOISE, 713008, GEM STATE, 7 

15130 DATA ILLINOIS, SPRINGFIELD, CHICAGO, 11113976, PRAIRIE STATE, 7 
15140 DATA INDIANA, INDIANAPOLIS, INDIANAPOLIS, 5193669, HOOSIER STATE, ? 
15150 DATA IOWA, DES MOINES, DES MOINES, 2825041, HAWKEYE STATE, 7 
15160 DATA KANSAS, TOPEKA, WICHITA, 2249071, SUNFLOWER STATE, 7 
15170 DATA KENTUCKY, FRANKFORT, LOUISVILLE, 3219311, BLUE GRASS STATE, ? 
15180 DATA LOUISIANA, BATON ROUGE, NEW ORLEANS, 3643180, PELICAN STATE, ? 
15190 DATA MAINE, AUGUSTA, PORTLAND (EAST), 993663, PINE TREE STATE , ? 
15200 DATA MARYLAND, ANNAPOLIS, BALTIMORE, 3922399, OLD LINE STATE, FREE STATE 
15210 DATA MASSACHUSETTS, BOSTON, BOSTON, 5689170, BAY STATE, OLD COLONY 
15220 DATA MICHIGAN, LANSING, DETROIT, 8875083, WOLVERINE STATE, 7 
15230 DATA MINNESOTA, ST PAUL, MINNEAPOLIS, 3805069, NORTH STAR STATE, GOPHER ST 

ATE 
15240 DATA MISSISSIPPI, JACKSON, JACKSON, 2216912, MAGNOLIA STATE, 7 
15250 DATA MISSOURI, JEFFERSON CITY, ST LOUIS, 4677399, SHOW ME STATE, 7 
15260 DATA MONTANA, HELENA, BILLINGS, 694409, TREASURE STATE, 7 
15270 DATA NEBRASKA, LINCOLN, OMAHA, 1483791, CORNHUSKER STATE, 7 
15280 DATA NEVADA, CARSON CITY, LAS VEGAS, 488738, SILVER STATE, 7 
15290 DATA NEW HAMPSHIRE, CONCORD, MANCHESTER, 737681, GRANITE STATE, ? 
15300 DATA NEW JERSEY, TRENTON, NEWARK, 7168164, GARDEN STATE, 7 
15310 DATA NEW MEXICO, SANTA FE, ALBUQUERQUE, 1016000, LAND OF ENCHANTMENT, ? 
15320 DATA NEW YORK, ALBANY, NEW YORK, 18241266, EMPIRE STATE, ? 
15330 DATA NORTH CAROLINA, RALEIGH, CHARLOTTE, 5082059, TARHEEL STATE, 7 
15340 DATA NORTH DAKOTA, BISMARCK, FARGO, 617761, FLICKERTAIL STATE, SIOUX STATE 
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15350 DATA OHIO, COLUHBOS, CLEVELAND, 10652017, BUCKEYE STATE, ? 

1536B DATA OKLAHOMA, OKLAHOMA CITY, OKLAHOMA CITY, 2559253, SOONER STATE, ? 

15370 DATA OREGON, SALEM, PORTLAND (WEST), 2091385, BEAVER STATE, ? 

15380 DATA PENNSYLVANIA, HARRISBURG, PHILADELPHIA, 117 93909, KEYSTONE STATE, ? 

15390 DATA RHODE ISLAND, PROVIDENCE, PROVIDENCE, 949723, LITTLE RHODY, ? 

15400 DATA SOUTH CAROLINA, COLOMBIA, COLUMBIA, 2590516, PALMETTO STATE, ? 

15410 DATA SOUTH DAKOTA, PIERRE, SIOUX FALLS, 666257, COYOTE STATE, SUNSHINE STA 

TE 
15420 DATA TENNESSEE, NASHVILLE, MEMPHIS, 3924164, VOLUNTEER STATE, ? 
15430 DATA TEXAS, AUSTIN, HOUSTON, 11196730, LONE STAR STATE, ? 
15440 DATA UTAH, SALT LAKE CITY, SALT LAKE CITY, 1059273, BEEHIVE STATE, ? 
15450 DATA VERMONT, MONTPELIER, BURLINGTON, 444732, GREEN MOUNTAIN STATE, ? 
15460 DATA VIRGINIA, RICHMOND, NORFOLK, 4648494, OLD DOMINION, ? 
15470 DATA WASHINGTON, OLYMPIA, SEATTLE, 3409169, EVERGREEN STATE, ? 
15480 DATA WEST VIRGINIA, CHARLESTON, HUNTINGTON, 1744237, MOUNTAIN STATE, ? 
15490 DATA WISCONSIN, MADISON, MILWAUKEE, 4417933, BADGER STATE, 7 
15500 DATA WYOMING, CHEYENNE, CHEYENNE, 332416, EQUALITY STATE, ? 



PRESIDENTS: by Robert F. Nichol 



Who was the thirty-ninth 
president of the United States? 
What number president was 
Millard Fillmore, and where was 
he born? When was Harry S. 
Truman first innaugurated? The 
Presidents program gives all the 
data you'll need to answer these 
thought-provoking questions. As 
an added plus, it will also require 
you to spell all Presidential 
names correctly. 



PRESIDENT - RICHARD NIXON 

PARTY - REPUBLICAN 

# OF PRESIDENCY - THIRTY-SEVENTH 



YEAR OF TNNAUGURATION - 1969 



STATE OF BIRTH - CALIFORNIA 



HIT ENTER TO CONTINUE? _ 



100 CLS:RANDOM:CLEAR100:N=39:DIMSS(N),S(N),C$(N),L$(N),P(N),PAS(N) 
120 FORX=lTON:READS$(X) ,C$(X),L$(X) ,P(X) ,PA$(X) :NEXT X 
500 CLS:PRINTCHRS(23) 
510 PRINT664,"M E N U :": PRINT 
520 PRINT" 1 - PRESIDENTIAL FACTS 
530 PRINT" 2 - PRESIDENTS IN ORDER 
540 PRINT" 3 - PARTY 
550 PRINT" 4 - * OF PRESIDENCY 
560 PRINT" 5 - STATE OF BIRTH 
570 PRINT" 6 - YEAR OF INNAUGURATION 
580 PRINT:PRINT"('M' TO RETURN TO THIS MENU) 
590 PRINT: INPUT'ENTER NUMBER OF YOUR CHOICE";CH 
600 IFCH<1 OR CH>6 THEN500 

610 ON CH GOTO 1000, 3000, 5000, 7000, 9000, 11000 
1000 REM PRINT INFORMATION FOR A SPECIFIC PRESIDENT 
1010 CLS:PRINTCHR$(23) 

1020 PRINT'ENTER NAME OF PRESIDENT" : PRINT : INPUT" ";SS 
1030 IFS$="M" THEN 500 
1040 FOR X=1T0N 
1050 IF SS(X)=S$ THEN 1100 
1060 NEXT X 

1070 PRINT:PRINT:PRINTS$:PRINT"IS NOT A PRESIDENT" :PRINT:PRINT"OF THE UNITED STA 
TES1" 
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1080 FOR TI=1TO750: NEXT TI: GOTO1010 

1100 CLS:PRINTe0,CHR$(23); 

1110 PRINT"PRESIDENT - ";SS(X) 

1120 PRINT:PRINT"PARTY - ";C$(X) 

1130 PRINT:PRINT"# OP PRESIDENCY - ";L$ (X) ; : IFX=22THENPRINT" AND T 

WENTY-FOURTH"ELSEPRINT 
1140 PRINT: PRINT'YEAR OF INNAUGURATION - " ;P (X) ; : IFX=22THENPRINT" 

AND 1893"ELSE PRINT 
1180 PRINT:PRINT"STATE OF BIRTH - ";PA$(X) 

1200 PRINT:PRINT:INPUT"HIT ENTER TO CONTINUE" ; EN:GOTO1010 
3000 REM ENTER PRESIDENTS IN ORDER 

3010 W=0:CLS:PRINTe0,CHR$(23); "PRESIDENTS IN NUMERICAL ORDER 
3015 PRINT: PRINT"NAME OF FIRST PRESIDENT" : INPUTS$: IFSS=S$ (1) THEN 3020 ELSE PRINT 

"NO, GEORGE WASHINGTON IS FIRST! " :W=W+1 
3020 FOR X=2TON 

3030 PRINT: PRINT'PRESIDENT #" ;X; "IS" : INPUTS? 
303S IF S$="M" THEN 500 
3040 IFSS=S$(X) THEN 3060 

3050 W=W+l:PRINT"WRONG, ";S$(X);° IS NEXT!" 
3060 NEXT X:PRINTSTRING$(32,131); 
3070 PRINT:PRINT"RIGHT =";N-W;" WRONG =" ;W; : PRINT:PRINT:PRINT"SCORE =";:PRINT US 

ING"#t #.##"; 100* (N-W)/N;: PRINT" %" 
3080 PRINT:PRINT:INPUT"HIT ENTER TO RETURN TO MENU"; EN: GOTO 500 
5000 REM PRESIDENTS AND THEIR PARTY 
5010 FORX=lTON: S(X)=0: NEXT X 
5020 R=0: W=0 

5030 CLS: PRINT@0,CHR$(23); 

5040 PRINT"HOW MANY QUESTIONS (1-" ;N; ")";: INPUTQ: IFQ<10RQ>N THEN 5030 
5050 CLS 

5120 FOR X=1T0Q: CLS: PRINT8128,CHRS (23) ; 
5130 S=RND(N) : IF S(S)=1 THEN 5130 

5150 S(S)=1:PRINT"WHAT IS THE PARTY OF" : PRINT: PRINT" ";SS(S) 
5160 PRINT:INPUT" ";CS:PRINT 
5165 IF CS="M" THEN 5205 

5170 IF C$=C$(S) THEN R=R+1: PRINT'CORRECTl ":GOTO5200 
5180 W=W+1: PRINT"WRONG...";CS(S):PRINT:PRINT"IS THE PARTY OF ";S$(S) 
5200 IFX<QTHENPRINT:INPUT"HIT ENTER TO CONTINUE", -EN: NEXT 
5205 PRINT:PRINT"RIGHT =";R; "WRONG =";W 

5210 PRINT: PRINT "SCORE = "; :PRINTUSING"###.##";100*(R/(R+W+. 000001) ); :PRINT" %" 
5220 PRINT:PRINT:INPUT"HIT ENTER TO CONTINUE"; EN: GOTO500 
7000 REM PRESIDENT AND # OF PRESIDENCY 
7010 FOR X=1T0N: S(X)=0: NEXT X 
7020 R=0: W=0 

7030 CLS: PRINT60,CHR$(23) ; 

7040 PRINT"HOW MANY QUESTIONS (1-";N; ")";: INPUTQ: IF Q<1 OR Q>N THEN 7030 
7050 CLS 

7060 PRINT664,CHRS(23);"M E N U : 
7070 PRINT: PRINT" 1 - GIVE PRESIDENCY 
7080 PRINT:PRINT" 2 - GIVE PRESIDENT 
7090 PRINT:PRINT" 3 - MIXED 
7100 PRINT:PRINT:INPUT"ENTER NUMBER OF YOUR CHOICE";SC: IF SC<1 OR SC>3 THEN 705 


7110 ON SC GOTO 7120, 7500, 7800 
7120 FOR X=1T0Q: CLS: PRINT§12B,CHR${23) ; 
7130 S=RND(N): IF S(S)=1 THEN 7130 
7135 S(S)=1 
7140 IFS=22THENPRINT"WHAT WAS THE FIRST PRESIDENCY OF" :PRINT:PRINT" ";SS(S): 

GOTO7160 
7145 IFS=24THENPRINT"WHAT WAS THE 2ND PRESIDENCY OF" : PRINT: PRINT" ";SS(S):GO 

TO7160 
7150 PRINT'WHAT IS THE PRESIDENCY OF" : PRINT: PRINT" ";SS(S) 
7160 PRINT:INPUT" ";LS:PRINT 
7170 IFL$="M" THEN 7205 
7175 IPVAL(LS)OSTHBN7190 
7180 R=R+1: PRINT'CORRECTl": GOTO 7200 

7190 W=W+1: PRINT"WRONG...";S:PRINT"IS THE PRESIDENCY OF ":PRINTSS(S) 
7200 IF SC=3 THEN 7B40 ELSE IFX<QTHENPRINT: INPUT'HIT ENTER TO CONTINUE" ;EN:NEXT 
7205 GOTO 5205 

7500 FOR X=1T0Q: CLS: PRINTei28,CHRS (23) ; 
7510 S=RND(N) : IF S(S)=1 THEN 7510 
7520 S(S)=1: PRINT"WHO WAS THE " ;L$ (S) : PRINT: PRINT"PBESIDENT OF THE UNITED STATE 

S 
7530 PRINT: INPUT" ",-SS:PRINT 
7540 IF SS="M" THEN 7580 

7550 IF SS=SS(S) THEN R=R+1: PRI NT "CORRECT! ": GOTO 7570 
7560 W=W+1: PRINT"WRONG...THE " ;L$ (S) :PRINT"PRESIDENT OF THE 0. S. WAS" :PRINTSS ( 

S) 
7570 IF SC=3 THEN 7840 ELSE IF X<Q THEN PRINT:INPUT"HIT ENTER TO CONTINUE" ;EN: N 

EXT 
7580 GOTO 5205 

7800 FOR X=1T0Q: CLS: PRINTS128,CHR$ (23) ; 
7810 S=RND(N): IF S(S)=1 THEN 7810 
7820 M=RND(2) 
7830 ON M GOTO 7150, 7520 

7840 IF X<Q THEN PRINT: INPUT'HIT ENTER TO CONTINUE";EN: NEXT 
7850 GOTO5205 
9000 REM PRESIDENT AND STATE OF BIRTH 
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9010 R=0:W=0:CLS:PRINT60,CHR$(23) ; 

9015 FORX=1TON:S(X)=0:NEXT 

9020 PRINT"HOW MANY QUESTIONS (1-" ;N-1; ")";: INPUTQ: IFQ<1 OR Q>N-1 THEN9010 

9120 FORX=lTOQ: CLS: PRINTS0,CHR$ (23) ; 

9130 S=RND(N) : IP S(S)=1 THEN 9130 

9150 S(S)=1 

9154 IFS=22THENS(24)=1 

9156 IFS=24THENS(22)=1 

9160 PRINT'WHERE WAS PRESIDENT" :PRINT:PRINTS$ (S) ; " BORN 

9180 PRINT: INPUTPS 

9190 IFP$="M"THEN 5205 

9200 IFP$=PA§(S)THENR=R+1:PRINT:PRINT"CORRECTI":GOTO9220 

9210 W=W+1: PRINT :PRINT"WRONG... HE WAS BORN IN ": PRINT: PRINTPAS (S) 

9220 PRINT: IF X<Q THEN INPUT"HIT ENTER TO CONTINUE";EN: NEXT 

9230 GOTO5205 

11000 REM PRESIDENT AND YEAR OF INNAUGORATION 

11010 FORX=lTON: S(X)=0: NEXT X 

11020 R=0: W=0 

11030 CLS: PRINT60,CHR$(23); 

11050 CLS:PRINT@0,CHR$(23); 

11060 PRINT"HOW MANY QUESTIONS (1-" ;N; ")";: INPUTQ: IFQ<1 OR Q>N THEN 11050 

11070 CLS 

11080 FORX=lTOQ: CLS : PRINT60 ,CHR$ ( 23 ) 

11090 S=RND(N): IF S(S)=1 THEN 11090 

11100 S(S)=1 

11104 IFS=22THENPRINT"WHEN WAS ";S$ (S) :PRINT"FIRST "; :GOTO11120 

11106 IFS=24THENPRINT"WHEN WAS " ;SS (S) :PRINT"RE-" ; :GOTO11120 

11110 PRINT'WHEN WAS ";SS(S) 

11115 PRINT 

11120 PRINT"INNAUGURATED";:INPUT" " ; P$: IFP$="M"THEN 5205 

11125 P=VAL(P$) 

11130 IFP=P(S)THENR=R+1: PRINT :PRINT"RIGHT1":GOTO11200 

11140 W=W+l:PRINT:PRINT"NO, HE WAS INNAUGURATED IN";P(S) 

11200 PRINT:IF X<Q THEN INPUT"HIT ENTER TO CONTINUE", -EN: NEXT 

11210 GOTO5205 

15000 DATA GEORGE WASHINGTON, FEDERALIST, FIRST, 1789, VIRGINIA 

15010 DATA JOHN ADAMS, FEDERALIST, SECOND, 1797, MASSACHUSETTS 

15020 DATA THOMAS JEFFERSON, DEMOCRATIC-REPUBLICAN, THIRD, 1801, VIRGINIA 

15030 DATA JAMES MADISON, DEMOCRATIC -REPUBLICAN, FOURTH, 1809, VIRGINIA 

15040 DATA JAMES MONROE, DEMOCRATIC -REPUBLICAN, FIFTH, 1817, VIRGINIA 

15050 DATA JOHN QUINCY ADAMS, DEMOCRATIC-REPUBLICAN, SIXTH, 1825, MASSACHUSETTS 

15060 DATA ANDREW JACKSON, DEMOCRAT, SEVENTH, 1829, SOUTH CAROLINA 

15070 DATA MARTIN VAN BUREN, DEMOCRAT, EIGHTH, 1837, NEW YORK 

15080 DATA WILLIAM HARRISON, WHIG, NINTH, 1841, VIRGINIA 

15090 DATA JOHN TYLER, DEMOCRAT, TENTH, 1841, VIRGINIA 

15100 DATA JAMES POLK, DEMOCRAT, ELEVENTH, 1845, NORTH CAROLINA 

15110 DATA ZACHARY TAYLOR, WHIG, TWELFTH, 1849, VIRGINIA 

15120 DATA MILLARD FILLMORE, WHIG, THIRTEENTH, 1850, NEW YORK 

15130 DATA FRANKLIN PIERCE, DEMOCRAT, FOURTEENTH, 1853, NEW HAMPSHIRE 

15140 DATA JAMES BUCHANAN, DEMOCRAT, FIFTEENTH, 1857, PENNSYLVANIA 

15150 DATA ABRAHAM LINCOLN, REPUBLICAN, SIXTEENTH, 1861, KENTUCKY 

15160 DATA ANDREW JOHNSON, REPUBLICAN, SEVENTEENTH, 1865, NORTH CAROLINA 

15170 DATA ULYSSES GRANT, REPUBLICAN, EIGHTEENTH, 1869, OHIO 

15180 DATA RUTHERFORD HAYES, REPUBLICAN, NINETEENTH, 1877, OHIO 

15190 DATA JAMES GARFIELD, REPUBLICAN, TWENTIETH, 1881, OHIO 

15200 DATA CHESTER ARTHUR, REPUBLICAN, TWENTY-FIRST, 1881, VERMONT 

15210 DATA GROVER CLEVELAND, DEMOCRAT, TWENTY-SECOND, 1885, NEW JERSEY 

15220 DATA BENJAMIN HARRISON, REPUBLICAN, TWENTY-THIRD, 1889, OHIO 

15230 DATA GROVER CLEVELAND, DEMOCRAT, TWENTY-FOURTH, 1893, NEW JERSEY 

15240 DATA WILLIAM MCKINLEY, REPUBLICAN, TWENTY-FIFTH, 1897, OHIO 

15250 DATA THEODORE ROOSEVELT, REPUBLICAN, TWENTY-SIXTH, 1901, NEW YORK 

15260 DATA WILLIAM TAFT, REPUBLICAN, TWENTY-SEVENTH, 1909, OHIO 

15270 DATA WOODROW WILSON, DEMOCRAT, TWENTY-EIGHTH, 1913, VIRGINIA 

15280 DATA WARREN HARDING, REPUBLICAN, TWENTY-NINTH, 1921, OHIO 

15290 DATA CALVIN COOLIDGE, REPUBLICAN, THIRTIETH, 1923, VERMONT 

15300 DATA HERBERT HOOVER, REPUBLICAN, THIRTY-FIRST, 1929, IOWA 

15310 DATA FRANKLIN ROOSEVELT, DEMOCRAT, THIRTY-SECOND, 1933, NEW YORK 

15320 DATA HARRY TRUMAN, DEMOCRAT, THIRTY-THIRD, 1945, MISSOURI 

15330 DATA DWIGHT EISENHOWER, REPUBLICAN, THIRTY-FOURTH, 1953, TEXAS 

15340 DATA JOHN KENNEDY, DEMOCRAT, THIRTY-FIFTH, 1961, MASSACHUSETTS 

15350 DATA LYNDON JOHNSON, DEMOCRAT, THIRTY-SIXTH, 1963, TEXAS 

15360 DATA RICHARD NIXON, REPUBLICAN, THIRTY-SEVENTH, 1969, CALIFORNIA 

15370 DATA GERALD FORD, REPUBLICAN, THIRTY-EIGHTH, 1974, MICHIGAN 

15380 DATA JAMES CARTER, DEMOCRAT, THIRTY-NINTH, 1977, GEORGIA 
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CONSTITUTION: by Robert F. Nichol 



In this program, your TRS-80 
becomes a knowledge expert on 
the Constitution of the United 
States. Details on articles and 
ammendments, order of ratifica- 
tion and number are supplied. A 
recommended program for So- 
cial Studies, Government and 
American History classes. 



homes m ranoi or religion m speech m m ras m 

Tl£ MOTTO PETITION 
HIT ENTB! TO COHTIIU' . 



10 CLS 

20 POKE16553,255 

140 PUS="*##«.t#" 

150 DIM S$(13), S(13), AR$(22), AR(22), AMS(25), AM(25) 

200 F0RX=1T013:READSS(X) :NEXT 

210 F0RX=1T022: READ AR$(X):NEXT 

220 FOR X=1T025: READ AM$ (X) : NEXT 

500 CLS:PRINTe0,CHRS(23),-"M E N U :":PRINT 

510 PRINT" 1-INFORMATION ON ARTICLES 

520 PRINT:PRINT" 2-INFORMATION ON AMMENDMENTS 

530 PRINT:PRINT" 3-QUIZ ON ARTICLES 

540 PRINT: PRINT" 4-QUIZ ON AMMENDMENTS 

550 PRINT: PRINT" 5-ORDER OF RATIFICATION 

560 PRINT: PRINT: PRINT" (ENTER "M' TO RETURN TO MENU) 

570 PRINT: INPl)T"ENTER NUMBER OF YOUR CHOICE";CH:CLS:CH=INT(CH) : IFCH<10RCH>5THEN5 

00 
580 ON CH GOTO 1000, 3000, 5000, 7000, 9000 
1000 REM INFORMATION ON ARTICLES 
1010 CLS:PRINT@448,CHRS<23) ; "ENTER t OF ARTICLE"; : INPUT AR$: IF AR$="M" THEN 500 

ELSE AR=VAL(AR$) :CLS: AR=INT(AR): IFAR<1 OR AR>7 THEN1010 
1020 PRINT"ARTICLE #";AR:PRINT 

1030 ON AR GOTO 1040, 1050, 1060, 1070, 1080, 1090, 1100 
1040 A=l: B=7: GOTO1200 
1050 A=8: B=ll: GOTO1200 



1060 A=12 

1070 A=15 

1080 A=19 

1090 A=20 

1100 A=22 



B=14: 
B=18: 
B=19: 
B-21: 
B=22 



GOTO1200 
GOTO1200 
GOTO1200 
GOTO! 200 
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1200 FORX=A TO B: PRINTAR$(X): NEXT 

1210 PRINT: INPUT'HIT ENTER TO CONTINUE" ; ENS: GOTO 

3000 REM INFORMATION OF AMMENDMENTS 

3010 CLS:PRINT@448, CHRS (23) ; "ENTER I OF AMMENDMENT"; : INPUT AMS: IFAMS="M"THEN 5 

00 ELSE AM=VAL(AMS): CLS: AM=INT(AM): IFAM<10RAM>25THEN 3010 
3020 PRINT" AMMENDMENT t"; AM: PRINT 
3040 PRINT AM$(AM) 

3050 PRINT: INPUT"HIT ENTER TO CONTINUE" , -ENS : GOTO 3010 
5000 REM QUIZ ON THE ARTICLES OF THE CONSTITUTION 
5005 F0RS=1T022: AR(S) =0:NEXT:N=0:R=0 
5007 INPUT'HOW MANY TRIES PER QUESTION (1-3) ";TR: IF TR<1 OR TR>3 THEN CLS: GOTO 

5007 
5010 FOR C=l TO 22: N=N+1 

5020 CLS: PRINTS256, "WHICH ARTICLE OF THE CONSTITUTION 
5030 X=RND(22): IFAR(X)=1 THEN 5030 
5040 AR(X)=1: PRINT: PRINTARS(X) 
5045 PRINT 

5051 IFX<8THENB=1: GOTO5060 

5052 IFX<12THENB=2:GOTO5060 

5053 IFX<15THENB=3: GOTO5060 

5054 IFX<19THENB=4: GOTO5060 

5055 IFX<20THENB=5:GOTO5060 

5056 IFX<22THENB=6:GOTO5060 

5057 B=7 

5060 FOR Y=1T0 TR: INPUT AS: A=VAL(AS): IF AS="M" THEN N=N-1: GOTO 9110 

5065 IF A=B THEN R=R+1 : PRINT: PRINT "CORRECT I I I " :GOTO5100 

507 NEXTY 

5080 PRINT:PRINT"SORRY, THE ANSWER WAS ARTICLE «";B 

51.80 PRINT: INPUT'HIT ENTER TO CONTINUE";ENS:NEXTC 
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5110 PRINT:GOTO9110 

7008 HEM QDIZ ON THE AMMENDMENTS TO THE CONSTITUTION 

7010 F0RS=1T025: AMIS) =0:NEXT: N=0: R=0 

7020 INPUT"HOW MANY TRIES PER QUESTION (1-3)"; TR: IF TR<1 OR TR>3 THEN CLS: GOT 

O 7020 
7030 FOR C=1T0 25: N=N+1 

7040 CLS: PRINT8256, "WHICH AMMENDMENT TO THE CONSTITUTION 
7050 X=RND(25): IF AM(X)=1 THEN 7050 
7060 AM(X)=1: PRINT: PRINT AHS(X) 
7070 PRINT 

7080 FOR Y=1T0 TR: INPUT AS: A=VAL(AS): IF A$="M" THEN N=N-1: GOTO9110 
7090 IF A=X THEN R=R+1: PRINT: PRINT"CORRECTH I " :GOTO 7120 
7100 NEXT V 

7110 PRINT: PRINT "SORRY, THE ANSWER WAS AMMENDMENT #";X 
7120 PRINT: INPUT"HIT ENTER TO CONTINUE" j ENS: NEXT C 
7130 PRINT: GOTO 9110 

9000 REM ORDER OF RATIFICATION BY STATES 
9010 INPUT'HOW MANY TRIES PER QUESTION (1-3) " ;TR:CLS :TR=INT (TR) : IFTR<10RTR>3THEN 

9010 
9015 PRINTCHRS(23):N=0:R=0:Y=1 
9020 F0RS=1T013:N=N+1:Y=1 
9030 PRINT"WHAT STATE WAS t";S 
9040 INPUT SS: IF SS="M"THENN=N-1:GOTO9110 
9050 IFSS=SS(S)THENR=R+1:GOTO9100 
9060 Y=Y+1:IFY<TR+1 THEN9040 
9070 PRINT"THE ANSWER WAS ";S$(S) 
9100 PRINT:Y=1:NEXTS 

9110 PRINT:PRINT"RIGHT =":R;" WRONG =";N-R 

9120 PRINT: PRINT'SCORE =" ! :PRINTDSING PU$; 100»R/ (N+. 00001) ; :PRINT" %" 
9130 PRINT: INPUT'HIT ENTER TO RETURN TO MENU";EN$: GOTO 500 
20000 DATA DELAWARE, PENNSYLVANIA, NEW JERSEY, GEORGIA, CONNECTICUT, MASSACHUSET 

TS, MARYLAND, SOUTH CAROLINA, NEW HAMPSHIRE, VIRGINIA, NEW YORK, NORTH CARO 

LINA, RHODE ISLAND 
20010 DATA ESTABLISHES THE HOUSE OF REPRESENTATIVES, ESTABLISHES THE SENATE, PR 

ESCRIBES FOR THE TIME AND PLACE AND MANNER OF HOLDING ELECTIONS, PR 

OVIDES FOR EACH HOUSE TO DETERMINE THE RULES FOR ITS PROCEEDINGS 

20020 DATA ESTABLISHES COMPENSATION AND PRIVELEGES OF SENATORS AND REPRE 

SENTATIVES, ESTABLISHES THE POWERS OF CONGRESS, PROHIBITS THE STATES FROM E 

XERCISING CERTAIN POWERS 
20030 DATA ESTABLISHES THE OFFICE OF THE PRESIDENT, ESTABLISHES THE PRESIDENT AS 
THE COMMANDER-IN-CHIEF, PROVIDES THAT THE PRESIDENT SHALL REPORT TO CONGRE 

SS UPON THE STATE OF THE UNION, PROVIDES FOR IMPEACHMENT 
20040 DATA ESTABLISHES JUDICIAL POWERS, ESTABLISHES THE SUPREME COURT, DEFINES T 

REASON 
20050 DATA ESTABLISHES THE RIGHTS OF THE STATES, ENTITLES THE CITIZENS OF EACH S 

TATE TO THE RIGHTS OF CITIZENS INALL OF THE STATES, PROVIDES FOR EXTRADITIO 

N OF A CITIZEN FROM ONE STATE TO ANOTHER, PROVIDES FOR ADMISSION OF NEW STA 

TES 
20060 DATA PROVIDES FOR AMMENDMENTS TO THE CONSTITUTION 

20070 DATA PROVIDES FOR TREATIES, REQUIRES AN OATH TO SUPPORT THE CONSTITUTION 
20080 DATA PROVIDES RULES FOR THE RATIFICATION OF THE CONSTITUTION 
20090 DATA PROVIDES FOR FREEDOM OF RELIGION AND SPEECH AND THE PRESS AND THE R 

IGHT TO PETITION 
20100 DATA PROVIDES FOR THE RIGHT TO KEEP AND BEAR ARMS 
20110 DATA SPEAKS ABOUT QUARTERING OF SOLDIERS 
20120 DATA REGULATES THE RIGHT OF SEARCH AND SEIZURE 
20130 DATA ESTABLISHES PROVISIONS CONCERNING PROSECUTION AND TRIAL AND PUNIS 

HMENT 
20140 DATA PROVIDES THE RIGHT TO A SPEEDY TRIAL AND TO CONFRONT WITNESSES AGAIN 

ST YOU 
20150 DATA PROVIDES FOR THE RIGHT TO A TRIAL BY JURY 
20160 DATA PROHIBITS EXCESSIVE BAIL OR FINES AND CRUEL PUNISHMENT 
20165 DATA PROVIDES THAT THE ENUMERATION IN THE CONSTITUTION OF CERTAIN RIGHT 

S SHALL NOT BE CONSTRUED TO DENY OR DISPARAGE OTHERS RETAINED BY THE 

PEOPLE 
20170 DATA RESERVES THE RIGHTS OF THE STATES UNDER THE CONSTITUTION 
20180 DATA CONSTRUES JUDICIAL POWERS 

20190 DATA ESTABLISHES THE MANNER OF CHOOSING THE PRESIDENT AND THE VICE- 
PRESIDENT 
20200 DATA ABOLISHED SLAVERY 

20210 DATA IS KNOWN AS THE RECONSTRUCTION AMMENDMENT 

20220 DATA PROVIDES FOR EQUAL RIGHTS FOR WHITE AND COLORED CITIZENS 
20230 DATA AUTHORIZES INCOME TAXES 

20240 DATA PROVIDES FOR THE DIRECT POPULAR ELECTION OF SENATORS 
20250 DATA PROHIBITED THE MANUFACTURE THE SALE AND THE TRANSPORTATION OF INTOX 

ICATING LIQUORS 
20260 DATA EXTENDED NATION-WIDE SUFFRAGE TO WOMEN 
20270 DATA ESTABLISHES THE TERMS OF THE PRESIDENT AND VICE PRESIDENT TO BEGIN 

ON JANUARY 20 AND THAT OF SENATORS ON JANUARY 3 
20280 DATA REPEALED THE PROHIBITION AMMENDMENT 

20290 DATA BARS THE PRESIDENT FROM SERVING MORE THAN TWO ELECTIVE TERMS 
20300 DATA GRANTS CITIZENS OF THE DISTRICT OF COLUMBIA THE RIGHT TO VOTE IN PR 

ESIDENTIAL ELECTIONS 
20310 DATA BARS THE USE OF A POLL TAX AS A PREREQUISITE IN FEDERAL ELECT 

IONS 
20320 DATA ESTABLISHES THE PROCEDURES TO BE FOLLOWED IN THE EVENT OF THE DEATH 
OR DISABILITY OF THE PRESIDENT 
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WHOLE NUMBER CONCEPTS: by Robert F. Nichol 



More math for those who need 
it. This unique program will re- 
quire you to round off decimals, 
translate words into numbers, 
identify place positions and 
more. Worthwhile drills on some 
necessary, but often neglected 
math procedures. 



mWI H-- lit'. 



YOU HAD A TOTAL OF .8 TRIES AND 
ANSWERED CORRECTLY. £ TIMES FOR 
A GRADE OF iBB PERCENT. 



CONGRATULATIONS! ! GREAT .WORK! 



I'M FINISHED BUT IF YOU WANT TO 
CONTINUE/ TYPE 'RUN'.. ';'•• 



10 RANDOM :CLEAR200 

16 ON ERROR GOTO6000 

50 CLS:PRINT:PRINT:PRINTCHR$(23); 



'MATH QUIZ TOPICS:": PRINT 



60 PRINT" 1 - GIVE DIGIT 

70 PRINT" 2 - GIVE PLACE VALUE 

80 PRINT" 3 - ROUND OFF 

90 PRINT" 4 - WORDS TO NUMBER 

100 PRINT" 5 - NUMBER TO WORDS 

120 PRINT:PRINT:PRINT:PRINT"(TO RETURN TO MENU, ENTER 'M' ) ":PRINT: INPUT"ENTER NU 

MBER OF YOUR CHOICE" ; Z :CLS: IFZ<10RZ>50RZOINT(Z) THEN50 
130 ONZGOTO1000, 2000, 3000, 4000, 5000 
1000 REM GIVE DIGIT OF GIVEN PLACE VLAUE 

1010 INPUT"ENTER MAXIMUM NUMBER OF DIGITS (3-9) " ;X:CLS : IFX<3ORX>9THEN1010 
1020 N=0:R=0 
1030 GOSUB2020 
1040 PRINTCHR$(23) 

1060 P=RND(U) :N$=MID$(X$,U+1-P,1> 
1065 PRINTX?;" ",- 

1070 PRINT"WHAT DIGIT IS IN THE " :QOSUB1100 : PRINTG$; • PLACE "; 
1080 INPUTA$:IFA$="M"THENCLS:PRINTg460,CHR$ (23), -"SCORE: " ; (R/N) *100; "%" :FORT=lTO 

1500:NEXT:GOTO50 
1090 N=N+l:R=R+l:IFA$=NSTHENPRINT"CORRECT"ELSE PRINT"WRONG, THE DIGIT IN THE":PR 

INTG?;" PLACE IS ",-N$; "!! I " :FORT=1TO500:NEXT:R=R~1 
1095 PRINT :GOTO1030 

1100 ONPGOTO1110, 1120, 1130, 1140, 1150, 1160, 1170, 1180, 1190 
1110 G5="ONES":RETURN 
1120 GS="TENS":RETURN 
1130 GS="HUNDREDS":RETURN 
1140 G$="THOUSANDS":RETURN 
1150 G$="TEN THOUSANDS" :RETURN 
1160 G$="HUNDRED THOUSANDS" : RETURN 
1170 GS="MILLIONS":RETURN 
1180 G$="TEN MILLIONS" :RETURN 
1190 G$="HUNDRED MILLIONS" :RETURN 
2000 REM GIVE PLACE VALUE OF A GIVEN DIGIT 

2010 INPUT"ENTER MAXIMUM NUMBER OF DIGITS (3-9) " ;X:CLS: IFX<3ORX>9THEN2010 
2012 N=0:R=0 
2015 GOSUB2020:GOTO2070 

2020 FORC=0TO9:C(C)=0:NEXT:XS="":U=X:IFX>5THENU=RND(X-3)+3 
2030 C(1)=RND(9) :FORD=2T0U 

204 C (D) =RND ( 1 ) -1 : FORG=1TOD-1 : IFC (D) =C (G) THEN2040 
2050 NEXTG,D 

2060 FORD=lTOU:X$=X?+RIGHT$(STR$(C(D)) ,1) :NEXT:RETURN 
2070 P=RND(U) :N$=MIDS(X$,U+1-P,1) 

2080 PRINTCHR?(231,-"IN THE NUMBER ";X$;" WHAT IS 
2090 PRINT"THE PLACE VALUE OF THE ";N$ 
2100 PRINT" ";:INPUTAS:GOSUB1100 
2110 IFA?="M"THENCLS:PRINM460,CHR$( 23); "SCORE: " ; (R/N) *100; "%" :FORT=1TO1500 :NEX 

T:GOTO50 
2120 N=N+l:R=R+l:IFA5=G$THENPRINT"CORRECT"ELSEPRINT"WRONG, THE ";N$;" IS IN THE" 

:PRINTGS;" PLACE! I 1 " :FORT=1TO500 :NEXT:R=R-1 
2130 PRINT:GOTO2015 
3000 REM ROUNDING OFF 
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3010 INPUT'ENTER MAXIMUM NUMBER OP DIGITS (3-9) " ;X:CLS: IFX<3ORX>9THEN3010 

3015 N=0:R=0 

3020 GOSUB2020 

3030 P=RND(U-1)+1 

3040 PRINTCHRS (23) ["ROUND ";X$;" TO THE NEAREST" :GOSUB1100 : PRINTGS; " ",-:INPUTAS 

3045 IFC (U+2-P) >4THENC(U+1-P) =C (U+l-P) +1 

3050 FORL=U+1-PTO1STEP-1:IFC(L)>9THENC(L)=0:C(L-1)=C(L-1)+1 

3051 NEXTL 

3052 IFC(0)>0THENK=0ELSEK=1 

3054 D$="":FORD=KTOU+l-P:D$=D$+RIGHT$(STR$(C(D)) ,1) :NEXT 

3060 E$="":FORV=1TOP-1:E$=E$+"0":NEXTV:D$=D$+E$ 

3070 IFAS="M"THENCLS:PRINTe460,CHRS(23) ; "SCORE: " ; (R/N) *100; "»" :FORT=1TO1500 :NEX 

T:GOTO50 

3080 N=N+1:IFA$OD$THENPRINT"WRONG, THE ANSWER IS " ;D$; "1 I! " :FORT=1TO500 : NEXT 

3090 IFA$=D$THENPRINT"CORRECT" :R=R+1 

3100 PRINT:GOTO3020 

4000 REM GIVING NUMBER FOR A GIVEN WORD EXPRESSION 

4005 Y=0:N=0 

4007 INPUT"WHAT IS THE MAXIMUM NUMBER OF DIGITS (3-9) " ;X :CLS : IFX<3ORX>9THEN4007 

4008 GOSUB4010:GOTO4100 

4010 AS="":R$="":NS="":F§="":X$="" 

4020 GOSUB2020:F5=XS 

4030 L=LEN(X$) :J=INT(L/3) :K=L-J*3: IFL<4THENV=0 

4032 IFL>3THENV=1 

4034 IFL>6THENV=2 

4035 IFK=0THEN4050 

4040 A$=LEFT$(X$,K) :A=VAL(A$) :X?=RIGHTS (X$,L-K) :L=LEN(XS) 

4048 GOSUB4500 

4050 FORZ=1TOJ:A$=LEFT?(X$,3) :A=VAL(A$) :XS=RIGHT$ (XS, L-3) :L=LEN(X$) :GOSUB4500 :NE 

XTZ 

4060 RETURN 

4100 PRINTNS;" =" 

4110 INPUTQS 

4120 IFQ$="M"THENCLS:PRINTe460,CHRS( 23); "SCORE: " ; (Y/N) *100; "%" :FORT=1TO1500 :NEX 

TT:GOTO50 

4130 N=N+1:IFQ$OF$THENPRINT"WRONG, THE ANSWER IS ";FS;"!1!" 

4140 IFQS=FSTHENPRINT"CORRECT":Y=Y+l 

4150 PRINT:GOTO4008 

4500 IFLEN(A$X3THEN4520 

4510 RS=LEFT$(A$,1) :A$=RIGHT$ (A?, 2) :R=VAL(RS) : A=VAL (AS) : IFR=0THEN4520 

4515 GOSUB4600:NS=N$+" HUNDRED" 

4520 IFA>9ANDA<20THENR=VAL(RIGHTS(AS,1) ) :GOSUB4700 :GOSUB4900 :RETURN 

4525 R=0:IFLEN(AS)=2THENR$=LEFT$(A$,1) :R=VAL(R$) 

4530 A$=RIGHT$(AS,1) :A=VAL(A$) : IFR=0THEN4540 

4535 GOSUB4800 

4540 R=A:IFR=0THENGOTO4560 

4550 GOSUB4600 

4560 GOSUB4900:RETURN 

4600 ONRGOTO4610,4620,4630,4640,4650,4660,4670,46 80,46 90 

4610 N$=N$+" ONE":RETURN 

4620 N$=NS+" TWO":RETURN 

4630 NS=N$+" THREE" :RETURN 

4640 N$=NS+" FOUR":RETURN 

4650 N$=N$+" FIVE":RETURN 

4660 NS=N$+" SIX":RETURN 

4670 N$=NS+" SEVEN" :RETURN 

4680 N$=N$+" EIGHT" :RETURN 

4690 N$=N$+" NINE":RETURN 

4700 IFR=0THENN$=N$+" TEN":RETURN 

4705 ONRGOTO4710, 4715, 4720, 4725, 4730, 4735, 4740, 4745, 4750 

4710 NS=N$+" ELEVEN" :RETURN 

4715 NS=NS*° TWELVE" :RETURN 

4720 N$=N$+" THIRTEEN": RETURN 

4725 NS=NS+" FOURTEEN": RETURN 

4730 N$=NS+" FIFTEEN" :RETURN 

4735 NS=NS+" SIXTEEN" :RETURN 

4740 NS=N$+" SEVENTEEN": RETURN 

4745 NS=N$+" EIGHTEEN" :RETURN 

4750 N$=NS+" NINETEEN" :RETURN 

4800 ONRGOTO4805, 4810, 4820, 4830, 4840, 4850, 4860, 4870, 4880 

4805 RETURN 

4810 NS=N$+" TWENTY ":RETURN 

4820 NS=N$+" THIRTY" :RETURN 

4830 NS=NS+" FORTY" :RETURN 

4840 NS=N$+" FIFTY" :RETUHN 

4850 N$=N$+" SIXTY" :RETURN 

4860 N$=N?+" SEVENTY": RETURN 

4870 N$=N$+" EIGHTY":RETURN 

4880 N$=N$+" NINETY ":RETURN 

4900 IFVC1THENRETURN 

4910 ONVGOTO4920,4930 

4920 N$=N$+" THOUSAND" :V=V-1: RETURN 

4930 N$=NS+" MILLION" : V=V-1 :RETURN 

5000 REM WRITE WORD EXPRESSION FOR A GIVEN NUMBER 

5010 Y=0:N=0 

5020 INPUT'ENTER MAXIMUM NUMBER OF DIGITS (3-9) " ;X:CLS: IFX<3ORX>9THEN5020 

5030 HS="":GOSUB4010:E=LEN(N$):N$=RIGHTS(N$,E-1) 

30 



!(Y/N)*100;"%":FORT=1TO1500:NEX 



5040 PRINT"WRITE ";F?j" OUT IN WORDS..." 

5050 INPUTHS 

5060 IFH$="M"THENCLS:PRINTe460,CHRS (23), -"SCORE: 

TT:GOTO50 

5070 N=N+1:IFH$ON$THENPRINT"WRONG, THE CORRECT ANSWER IS":PRINTN$ 
5080 IFH$=N$THENPRINT"CORRECT" :Y=Y+1 
5090 PRINT:GOTO5030 
6000 RESUME 50 




MUSICAL INTERVALS TEST: by Hanley Jackson 



This unusual program will be 
popular with musically inclined 
TRS-80 owners. Your computer 
will visually generate two notes 
and ask you to identify the inter- 
val involved. All intervals be- 
tween prime and major 7th are 
fair territory, and you need not 
have perfect pitch to do well. 



10 CLEAR 1000:FILL$=" " 

20 CLS 

25 INPUT"WHAT LINE LENGTH ";LL 

30 INPUT"WHAT IS THE PROGRAM NAME" 

35 GOSOB 500 

40 OPEN "I", 1, PROGRAMS 

50 IF P=60 THEN GOSUB 500 

60 IF E0F(1) THEN GOTO 1000 

65 IF P>56 THEN GOSUB 500 

70 LINEINPUT tl, TEMPS 

80 A=LEN(TEMP5) 

85 L1$=TEMP$ 

90 IF A <= LL THEN 200 

100 L1$=LEFT$(TEMP$,LL) 

110 L2$=RIGHT$(TEMP$,(A-LD) 

120 B=LEN(L2$) 

130 IF B <= LL-5 THEN 200 

140 L2$=MIDS(TEMP?,LL+l,LL-5) 

142 L3S=RIGHT$(TEMPS,A-(2*LL-5)) 

143 C=LEN(L3$) 

145 IF C<=LL-5 THEN 200 
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150 L3$=MID$ (TEMPS, 2*LL-4,LL-5) 

155 S=3*LL-10:IF S>=A THEN 200 

160 L4$=RIGHT$(TEMP$,A~S) 

200 LPRINT L1$:P=P+1: IP A<LL+1 THEN 50 

210 LPRINT FILL$;L2$:P=P+1: IF B<LL-4 THEN 50 

220 LPRINT FILL$;L3$:P=P+1: IF C<LL-4 THEN 50 

230 LPRINT FILL$;L4$:P=P+1:G0T0 50 

500 LPRINT CHR$(12) 

530 PP=PP+1 

535 LPRINT 

540 LPRINT"PAGE #";PP;"OF ";PROGRAH$ 

545 LPRINT"" 

550 P=0: RETURN 

1000 LPRINT:LPRINT:LPRINT 

1010 LPRINT"DONE" 

1015 LPRINT CHR$(12) 

1020 CLOSE 

102S CMD"DIR :2" 

1030 INPUT"NEXT PROGRAM ";N$ 

1040 RUN NS 



PERCENT 1: by John Roland 



This is an excellent drill on 
ratios and percent for the 
younger generation or anyone 
else who cares to improve his or 
her level of skill in these areas. 




10 CLEAR450:DEPSTRA-C:DEFINTI-P:ND=6:CY.-"YES"!CR»"YOU'RE RIGHT, "|CW="S0RRY, YOU 
MADE A MISTAKE, ■ :DIMCM(31) ,CN(31) ,NT(31) ,OB(31,6) SL»10:P=100:C1-"YOU HAD 

"iC2=" % CORRECT. ":C3=" PLEASE SEE ":C4-" FOR AN ASSIGNMENT." 
15 C5="D0 YOU WANT TO GO ON":C6="DO YOU KNOW HOW TO " 
20 GOSUB895 
25 CLS: PRINT, "WHERE SHOULD I START?" : PRINT'STUDENT RECORD INPUT",, "1", "SEE STUDE 

NT RECORDS",, "2", "TAPE STUDENT RECORDS",, "3", "NORMAL STUDENT STARTING POINT 

",,"4",, "YOUR CHOICE OF OBJECTIVES", , "PERCENT TO DECIMAL", , "5", "PERCENT TO 

FRACTION",, "6" 
30 PRINT"30% OP 50 TYPE ",,,"7 "."FRACTION TO PERCENT",, "8 "."DECIMAL TO PERCENT",, 

"9", "20 IS WHAT PERCENT OF 40 TYPE", , "10", "4 IS 20« OF WHAT NUMBER TYPE",," 

11":PRINT"* CHANGE PARAMETERS",, "12","* SPECIAL",, , "13" 
35 INPUT'YOUR CH0ICE";I:IFIOlANDCT=""THENCLS:INPUT"WHAT IS THE TEACHER'S NAME"; 

CTELSEIFI=1THEN50 
40 IF(NZ=0)OR(I=12)THENCLS:PRINT"PLEASE GIVE PARAMETERS" : INPUT"* TO A DECIMAL, * 
<= (AN INTEGER) "|NZ:INPUT"A% OF B - C (A COMMA B COMMA C ALL INTEGERS) "jNY 

,NX,NU:INPUT"FRACTION TO A PERCENT (NUMERATOR COMMA DENOMINATOR BOTH INTEGE 

RS)";NW,NV:G0TO25 
45 IF(I>4)AND(K12)THENCLS:NA=30:INPUT"WHAT IS YOUR FIRST NAME";CH 
50 ONIGOT055, 945, 970, 85, 160, 245, 400, 470, 690, 550 ,7 95, 40, 905 
55 CLS: PRINT "WHEN READY TO INPUT PUSH 'ENTER' . ":GOSUB880 
60 INPUT#"1,CT,NB,NZ,NY,NX,NW,NV,NU 
65 FORN=0TONBSTEP2 
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70 INPUT#-1,CN{N) ,CM(N) ,OB(N,0) ,0B(N,1) ,0B(N,2) ,0B(N,3) ,0B(N,4) ,0B(N,5) ,0B(N,6) , 

NT{N) ,CN(N+1) ,CM(N+1) ,OB(N+1,0) ,0B(N+1,1) ,0B(N+1,2) ,0B(N+1,3) ,0B(N+1,4) ,0B( 

N+l,5),OB(N+l,6) ,NT(N+1) 
75 NEXTN: PRINT" INPUT IS COMPLETE. PUSH ' ENTER' ." :GOSUB880 
80 GOT025 
85 CLS:RANDOM:IFN8<29THENGOSUB895ELSEPRINT"TELL ";CT;" THAT MY RECORD MEMORY IS 

FULL":A="":A=INKEYS:IFAO""THENGOSUB895ELSE85 
90 CLS:INPUT"WHAT IS YOUR FIRST NAME (TYPE NAME THEN PUSH ' ENTER' )" ;CM :PRINT: INP 

UT"WHAT IS YOUR LAST NAME";CN 
95 FORNA=0TONB:IFCM=CM(NA)ANDCN=CN(NA)THENNT(NA)=NT(NA)+1:GOTO115 
100 IFCM=CTTHEN25 
105 NEXTNA 
110 CLS:PRINT"YOU MUST BE NEW TO THIS PROGRAM, ";CM;". LET'S START AT THE 

BEGINNING. " :FORNA=0TONB: IFCN(NA) =""THENCN(NA) =CN: CM (NA) =CM:GOTO130 :ELSEN 

EXTNA 
115 FORN=0TOND:IFOB(NA,N)<60THEN120ELSENEXT 
120 I=N«:CLS:PRINT"REMEMBER YOU MUST PUSH 'ENTER' AFTER EVERY ANSWER. ONCE YOU 

PUSH 'ENTER' YOU CAN'T CHANGE YOUR ANSWER. " :GOSUB880 
125 GOTO50 

130 IFNA=NBTHENNB=NB+1:IFNB=31THENNB=30:CN(30)="":GOTO85 
135 PRINT" THIS PROGRAM IS TO TEACH AND TEST YOU ON SEVERAL DIFFERENT PARTS 

ABOUT PERCENT. WHEN YOU DO POORLY ON A PART, YOU WILL HAVE THE IDEA EXP 

LAINED AND WORK A FEW EXAMPLES WITH THE COMPUTER."; 
140 PRINT" THEN YOU WILL BE TOLD TO ASK ";CT,"FOR AN ASSIGNMENT ON THAT PART. 

IF YOU PASS A PART, 6 OUT OF 10 CORRECT, THEN YOU MAY GO ON TO THE NEXT PA 

RT AND THE COMPUTERWILL REMEMBER YOUR SCORE FOR THE NEXT TIME." 
145 PRINT: PRINT"BECAIISE THIS IS A MACHINE IT IS VERY FUSSY. YOU MUST ANSWER THE 

QUESTION EXACTLY RIGHT OR IT WILL BE WRONG. YOU CAN ALWAYS CHANGE YOUR 
ANSWER BEFORE YOU PUSH 'ENTER' BY USING THE LEFT ARROW KEY." 
150 PRINT"REMEMBER TO PUSH 'ENTER' AFTER EVERY ANSWER. ": INPUT"DO YOU SEE THE LEF 

T ARROW KEY ABOVE THE WHITE 'ENTER' KEY";A: IFA=CYTHEN160 
155 PRINT'LOOK JUST ABOVE THE WHITE 'ENTER' KEY TO SEE THE LEFT ARROW KEY.":GOTO 

150 
160 CLS:PR=0:K=0:J=0:PRINTC6;"CHANGE 45% TO A DECIMAL, ";CM; : INPUTA:IFAOCYTHENl 

95 
165 FORM=lTOL:N=RND(NZ):CLS:PRINTM,"CHANGE";N;" % TO A DECIMAL." 
170 INPUT'YOUR ANSWER";X:IFX=.0001THENGOTO85 

175 Y=X*P:IFY<=N+.0005ANDY>=N-.0005THENPRINTCR;CM:PR=PR+L:GOSUB880ELSBJ=J+1:PRIN 

TCWfCB,N/P:GOSUB8B0 
180 IFJ=5THEN195ELSENEXTM 
185 PRINT6256,CliPR;C2:GOSUB880 
190 IFPR>=60THEN240 
195 CLS:PRINT"YOU NEED SOME HELP, "(CM; ". LET ME TRY TO SHOW YOU HOW TO DO THIS 

KIND OF PROBLEM." 
200 PRINT: PRINT"TO CHANGE A * TO A DECIMAL ALWAYS MOVE THE DECIMAL TWO PLACES TO 
THE LEFT. LOOK AT THIS EXAMPLE. ":PRINT6404, "60% = .60" :PR=0:PRINT: INPUT"A 

RE YOU READY TO TRY ONE";A:IFA=CYTHEN205ELSE200 ».«um A 

205 FORM=1TOL:CLS:N=RND(100):PRINT"YOU TRY THIS ONE. CHANGE";Nj" % TO A DECIMAL 

210 INPUT'WHAT IS YOUR ANSWBR";X:Y=X*P:IFY<=N+.0005ANDY>=N-.0005THENPRINTCR;CM:P 

R=PR+L:GOSUB880ELSE220 
215 GOT0225 
220 PRINTCW;CM:IFN>=X*P*LTHENPRINT"YOU MOVED THE DECIMAL TOO FAR. " :GOSUB880ELSEI 

FX=NTHENPRINT"YOU DIDN'T MOVE THE DECIMAL." :GOSUB880ELSEPRINT"ASK "-CT:" FO 

R HELP.":GOSUB880 
225 NEXT 

230 PRINTe256,Cl;PR;C2:PRINTC3;CT;C4:GOSUB880 
235 GOT085 

240 OB(NA,0)=PR:PRINT"YOU HAVE FINISHED PART 1, TELL " ;CT; " . " :PRINTC5; : INPUTA- IF 
AOCYTHEN85 .™«iu,.i»mi«.u 

245 CLS:PR=0:PRINT"TIME TO START PART TWO.":PRINTC6; : INPUT"CHANGE A PERCENT TO A 

FRACTION IN SIMPLEST FORM"; A: IFA=CYTHENK=0: I=1:GOTO310 
250 CLS:PR=0:I=1:PRINT"OK. SO YOU NEED SOME HELP. LET ME TRY. TO CHANGE A PER 
CENT TO A FRACTION IN SIMPLEST FORM WE FIRST WRITE IT OVER 100 LIKE THIS 

255 PRINT6340,"60% = 60 / 100" :GOSUB880 

260 PRINT:PRINT"THEN FIND THE BIGGEST NUMBER THAT DIVIDES EVENLY INTO BOTH 60 

AND 100. THINK. ":GOSUB890 
265 PRINT'I THOUGHT OF 20. ":PRINT:PRINT" 60 / 20 - 3"-PRINT" 

100 / 20 » 5" 
270 PRINT: PRINT-SO WE SAY 60% - 60 / 100 = 3 / 5";:GOSUjB890 
275 CLS:PRINT"NOW YOU TRY ONE. ":PRINT:PRINT"CHANGE 30% TO A FRACTION IN SIMPLEST 

FORM." 
280 PRINT: INPUT"YOUR ANSWER";A:B="3/10" :IFA=BTHEN290 
285 PRINTCW, "MAKE SURE THAT YOU SIMPLIFY AND TYPE IN THE ANSWER CORRECTLY. TRY 

AGAIN. " : FORN=1TO1000 .-NEXTN :GOT027 5 
290 PRINTCR," LET'S TRY ANOTHER. ":GOSUB880 
295 CLS:PRINT"CHANGE 55 « TO A FRACTION IN SIMPLEST FORM. " :PRINT: INPUT"YOUR ANSW 

ER";A:B="11/20":IFA=BTHENPRINTCR:GOTO305ELSEPRINTCW;"MAKE SURE THAT YOU SIM 

PLIFY, TRY AGAIN. ":GOSUB880 
300 G0TO295 
305 GOSUB880 
310 CLS:IFK=LTHENV=RND(100) :PRINTI, "CHANGE ";V;" % TO A FRACTION IN SIMPLEST FO 

RM."ELSEGOT0375 
315 FORN=2T04STEP2:U=V/N:W=INT(U) :IFUOWTHEN325 
320 NEXTN 
325 FORM=5TO25STEP20:U=V/M:W=INT(U) : IFUOWTHEN335 
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330 NEXTM 

335 U=N-2:IFU=0THEN350 

340 X=V/U:Y=P/U:U=M-20:IFU<0THEN365 

345 X=X/U:Y=Y/U:GOT0365 

350 U=M-20:IFU<0THEN360 

355 X=V/U:Y=P/U:GOT0365 

360 X=V:Y=P 

365 INPUT'YOUR ANSWER";A:B=STR$(Y) :B="/"+MID$ (B,2,3) :B=MID$ (STR$ (X) ,2,3) +B:IFA=C 

TTHEN85ELSEIFA=BTHENPRINT:PRINTCR,CM:PR=PR+L:GOSUB880ELSEPRINT:PRINTCW;CM,B 

:GOSUB880 
370 I=I+1:GOTO310 
375 PRINT8256,C1;PR;C2:GOSUB880 
380 IFPR>=60ANDK=0THEN385ELSE390 

385 OB(NA,l)=PR:PRINTC5;: INPUTA: IFA=CYTHEN400ELSE85 
390 IFK=0THENK=1:GOTO250ELSEPRINTC3;CT;C4:GOSUB880 
395 GOT085 

400 CLS:PR=0:PRINTC6;"FIND 7 % OF $2.50"; : INPUTA: IFA=CYTHENK=0:GOTO430 
405 CLS:PRINT"OK, LET HE TRY TO HELP. TO FIND 7 % OF $2.50 WE FIRST CHANGE 7% 

TO A DECIMAL. ":INPUT"wHAT IS 7 % AS A DECIMAL" ;A:B=" .07 " 1 IFA=BTHEN415 
410 PRINT"SORRY, ABOUT THAT. WE ALWAYS MOVE THE DECIMAL TWO PLACES TO THE LEFT 

LIKE THIS 7% = .07 . " : INPUT"DO YOU UNDERSTAND"; A: IFAOCYTHEN410 
415 PRINT"OK, NOW MULTIPLY .07 X 2.50 . " : INPUT"WHAT IS YOUR ANSWER" ; A: IF (A=" .17 5 

")OR(A=".1750")THEN425 
420 PRINTCW;" CALL " ;CT; : INPUT" PLEASE. SHOULD THIS STUDENT CONTINUE" ; A: IFAO 

CYTHEN85 
425 PRINTCR,CM:K=L:PR=0:GOSUB880 
430 FORI=lTOL:V=RND(NY) :U=RND(NX) :W=U*V/P:CLS : PRINTI, "WHAT IS ";V;" % OF ";U;" ? 

":PRINT:INPUT"YOUR ANSWER N=" ; A:B=MID$ (STR$ <W) ,2,7) : IFA=CTTHEN85ELSEIFA=BTH 

ENPRINTCR;CM:PR=PR+L:GOSUB880ELSEPRINTCK;CM,B:GOSUB880 
435 NEXTI 

440 PRINT8256 , CI ; PR; C2 : IFPR>=60ANDK=0THEN465 
445 IFK=LTHEN455 
450 GOTO405 

455 PRINTC3;CT;C4:GOSUB880 
460 G0TO85 

465 OB ( NA, 2 ) =PR: PRINTC5 ; : INPUTA: IFA=CYTHEN470ELSE85 

470 K=0:PR=0:CLS:PRINTC6;:INPUT"CHANGE A FRACTION TO A PERCENT"; A: IFAOCYTHEN510 
475 FORM=lTOL 

480 CLS:W=RND(NW) :V=RND(NV) :U=W/V*P: IFU>500THEN480 
485 PRINTM, "CHANGE ";W;"/";V;" TO A PERCENT. ": INPUT"WHAT IS YOUR ANSWER. REMEMB 

ER USE NO MORE THAN 5 DIGITS. DO NOT ROUND. " ;A:B=STR$ (U) :B=MID$ (B, 2,6) +"%" : 

IFA=CTTHEN85ELSEIFB=ATHENPRINT:PRINTCR; CM: PR=PR+L:GOSUB880ELSEPRINT: PRINTCW 

;CM,B:GOSUB880 
490 NEXTM 

495 PRINT@256,C1;PR;C2:GOSUB880 

500 IFPR<60ANDK=0THEN510ELSEIFK=1THENPRINTC3;CT;C4:GOSUB880 
505 IFK=1THENGOTO85ELSEIFPR>=60THENOB(NA, 3 ) =PR:PRINTC5; : INPUTA: IFA=CYTHEN690ELSE 

85 
510 CLS:PR=0:K=1:PRINT"CHANGING A FRACTION TO A PECENT IS VERY EASY. REMEMBER T 

WO THINGS. ":PRINT:PRINT6212," / MEANS DIVIDE BY" :PRINT6340 , "MULTIPLY 

YOUR ANSWER BY 100. ":PRINT:PRINT"LET'S TRY ONE TOGETHER. " :PRINT:PRINT"CHANG 

E 2 / 5 TO A PERCENT." 
515 PRINT: PRINT"FIRST DIVIDE 2 BY 5. (REMEMBER YOUR DECIMAL POINT) ." :PRINT: INPU 

T"WHAT IS YOUR ANSWER" ;U:V=. 4 : IFU=VTHENPRINT"WELL DONE. NOW MULTIPLY YOUR A 

NSWER BY 100.":GOTO520ELSEPRINT"SORRY, THE CORRECT ANSWER IS .40. NOW MULT 

IPLY .40 BY 100. 
520 INPUT"WHAT IS YOUR ANSWER, (DON'T FORGET THE % SIGN) . ";A:B="40%" :IFA=BTHENPR 

INTCR;"LET'S TRY ANOTHER" :FORN=1TO2000 :NEXT:GOTO530 
525 B="40":IFA=BPRINT"YOU FORGOT THE PERCENT SIGN.":FORN=1TO2000:NEXTELSEPRINTCW 

;" THE CORRECT ANSWER IS 40%. LET'S TRY ANOTHER. " :GOSUB880 
530 CLS:PRINT"CHANGE 12 / 25 TO A PERCENT. " :INPUT"YOUR ANSWER TO THE DIVISION";A 

:B=".48":IFA=BTHENPRINTCR;" NOW MULTIPLY BY 100 . "ELSEPRINTCW; " THE CORRECT 

ANSWER IS .48." 
535 INPUT"WHAT IS YOUR ANSWER TO THE MULTIPLICATION. (REMEMBER % . ) " ;A:B="48%" : IF 

A-BTHENPRINTCR; " LET'S TRY 10." :GOSUB880 
540 GOT0475 

545 PRINT"CALL ";CT:INPUT"SHOULD THIS STUDENT CONTINUE"; A: IFA=CYGOT0475ELSE85 
550 PR-0:K"0:CLSlPRINTC6;"DO THIS KIND OF PROBLEM?" : PRINT: PRINT" 14 IS WHAT PERCE 

NT OF 105";: INPUTA: IFAOCYTHEN600 
555 FORI=lTOL:V=RND(NY) :U»RND(NX) :W=U*V/P:B=STR$ (V) :B=MID$(B,2,6) +"%" 
560 CLS:PRINTI,W;" IS WHAT PERCENT OF ";U; "?" :PRINT: INPUT"WHAT IS YOUR ANSWER";A 

lIFA=CTTHEN85ELSEIFAOBTHENPRINTCW;CM,B:GOSUB880ELSEPR=PR+L:PRINTCR;CM:GOSU 

B880 
565 NEXTI 

570 PRINT6256,C1;PR;C2:IFPR>=60ANDK=0THEN575ELSE580 
575 OB(NA, 5) =PR: PRINTC5; : INPUTA: IFA=CYTHEN7 95ELSE85 
580 IFPR<60ANDK=0THENGOSUB880ELSEGOTO590 
585 GOTO600 

590 PRINTC3;CT;C4:GOSUB880 
595 GOT085 
600 CLS:K=0:PRINT"LET ME TRY TO HELP. FIRST LET'S LOOK AT A PROBLEM. ": PRINTS148 

,"50 IS WHAT PERCENT OF 250?" :GOSUB880 
605 PRINT: INPUT'IF WE KNEW THE PERCENT AND THE 250 WHAT OPERATION WOULD WE DO TO 

FIND 50";A:IFA="MULTIPLY"THEN615 
610 PRINT'I'M NOT SURE WHAT YOU MEAN. I WANTED YOU TO TYPE 'MULTIPLY' ." :GOTO620 
615 PRINTCR;CM 
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620 INPUT"LET'S DIVIDE BY 250. WHAT DID YOU GET" ;A:B=" . 20" : IFA=BTHEN630ELSEB=" . 

2":IFA=BTHEN630 
625 PRINT"SORRY, I GET .20 . CHECK YOUR DIVISION." :GOSUB880 
630 INPUT"OK, OUR ANSWER IS .20 . LET'S MULTIPLY BY 100 AND TACK ON A % SIGN"; 

A:IFA="20%"THENPRINTCR;CM:GOTO640 
635 PRINT"SORRY, YOU SHOULD HAVE TYPED 20%." 
640 GOSUB880 
645 FORI=1TOL:V=RND(100):U=RND(100):W=U*V/P:B=STR$(V) :B=MID?(B,2,6) +"S" :CLS: PRIN 

TO,-" IS WHAT PERCENT OF ";U; "?" :PRINT: INPUT"WHAT IS YOUR ANSWER" , -A: IFA=CTTH 

EN85ELSEIFA=BTHENPRINTCR;CM:GOTO670 
650 B=LEFT$(B,2):IFA=BTHENPRINT"YOU FORGOT THE PERCENT SIGN. " :GOTO670 
655 W=V/P:B=STR$(W) :B=MID$ (B, 2,6) : IFA=BTHEN660ELSEB=B+"%" :IFA=BTHEN660ELSE665 
660 PRINT'YOU FORGOT TO MULTIPLY BY 100 . " :GOTO670 
665 PRINT:PRINT"I DON'T KNOW WHAT YOU DID WRONG. " :K=K+1 
670 GOSUB880 

675 IFK>4THEN6 80ELSENEXTI:IFK<3THEN590 
680 PRINT: PRINTCT,", I CAN'T HELP THIS STUDENT. THE ERRORS APPARENTLY AR 

E NOT IN USING THE % SIGN OR MULTIPLYING BY 100 . " :GOSUB880 
685 G0TO85 

690 CLS:PR=0:INPUT"DO YOU KNOW HOW TO CHANGE .37 TO A PERCENT" , -A: IFAOCYTHEN720 
695 FORI=1TOL 
700 CLS:U=RND(1000) :V=RND(4) :V=L[V:W=U/V:PRINTI, "CHANGE ";: C="»»» .####♦": PRINTUS 

INGC;W;: PRINT" TO A PERCENT. " :PRINT: INPUT"YOUR ANSWER" ;A:B=MID$ (STRS (W*P) , 2 

,4)+"%" 
705 IFA=CTTHEN85ELSEIFA=BTHENPRINTCR;CM:PR=PR+L:GOSUB880ELSEPRINTCW;CM,B:GOSUB88 


710 NEXTI 
715 PRINTe256,Cl;PR;C2:IFPR<60THENFORN=0TO1000:NEXTN:GOTO720ELSEOB(NA,4)=PR:PRIN 

TC5; : INPUTA: IFA=CYTHEN550ELSE85 
720 CLS:PR=0:K=0:INPUT"THIS IS EASY. DO YOU KNOW WHICH WAY IS TO THE RIGHT";A:I 

FAOCYTHENPRINT'THIS WAY";CHRS (94) ;CHR$(94) ;CHRS(94) 
725 INPUT"CAN YOU COUNT TO TWO" ;A: IFAOCYTHENPRINT'l", "2" 
730 PRINT"WHEN WE MULTIPY BY 100, WE MOVE THE DECIMAL TWO PLACES TO THE RIGHT. 

":PRINT"LOOK AT THIS EXAMPLE. " :PRINT: PRINT8404 , "1 .234 = 123 . 4%" : PRINT: PRINT 

"WE CAN'T FORGET THE % SIGN. " :GOSUB880 
735 FORI=lTOL 

740 CLS:U=RND(1000) :V=RND(4) :V=L[V:W=U/V:PRINTI, "CHANGE "; :C="f #♦.#♦#*«" :PRINTUS 
INGC;W;: PRINT" TO A PERCENT. ": PRINT: INPUT"YOUR ANSWER";A:B=MID$ (STRS(W*P) ,2 
,4)+"4":IFA=CTTHEN85 
745 IFA=BTHENPRINTCR;CM:PR=PR+L:GOTO770 
750 B=MIDS(STR$(W*P) ,2,4) : IFA=BTHENPRINTCWi " YOU FORGOT YOUR PERCENT SIGN. THAT 

MAKES THE ANSWER WRONG. " :GOTO770 
755 B=MID$(STR$(W),2,6) : IFA=BTHENPRINTCW; " YOU FORGOT TO MULTIPLY BY 100. YOU A 

LSO FORGOT YOUR PERCENT SIGN. YOU MUST MOVE YOUR DECIMAL TWO PLACES TO THE 
RIGHT AND YOU MUST USE THE PERCENT SIGN. " :GOTO770 
760 B=B+"%":IFA=BTHENPRINTCW;" YOU FORGOT TO MULTIPLY BY 100. YOU MUST MOVE YOU 

R DECIMAL TWO PLACES TO THE RIGHT. " :GOTO770 
765 PRINTCWiCM;" I DON'T KNOW WHAT YOU DID WRONG. ":K=K+1:IFK>4GOT0785 
770 GOSUB880 

775 NEXTI: PRINTS256, CI; PR;C2,,,C3;CT;C4:GOSUB880 
780 GOT085 
785 PRINTCT;" I CAN'T SEEM TO HELP THIS STUDENT. THE ERRORS ARE NOT THOSE FOR 

WHICH I AM PROGRAMMED. ":GOSUB880 
7 90 GOT085 
795 CLS:PR=0:PRINTC6;"DO THIS TYPE OF PROBLEM?" :PRINT:PRINT"4 IS 20 PERCENT OF W 

HAT NUMBER" ; : K=0 : INPUTA: IFA=CYTHEN860 
800 PR=0:PRINT"LET ME TRY TO HELP. TWO THINGS TO REMEMBER. ": PRINT: PRINT"FIRST, 

CHANGE % TO A DECIMAL. ":PRINT:PRINT"SECOND, DIVIDE BOTH SIDES OF THE EQUAT 

ION BY THE DECIMAL. " :PRINT: PRINT'FOR EXAMPLE. " :GOSUB890 
805 CLS:PRINT@281,"4 IS 20 PERCENT OF WHAT NUMBER?" :PRINT«45,"4=.20*N":GOSUB890 
810 PRINT8409,"THEN DIVIDE 4/. 20" :PRINT@47 3, "20=N" :GOSUB890 
815 PRINT'LET'S TRY ONE TOGETHER. " ; : PRINTS670 , "9 IS 30 PERCENT OF WHAT NUMBER?": 

INPUT"THE NEXT LINE SHOULD BE" ; A: IFA="9=.30*N"THENPRINTCRELSEPRINTCW, "9=.30 

*N":K=K+1 
820 INPUT"THEN WHAT OPERATION" ; A: IFA="DIVIDE"THENPRINTCRELSEPRINTCW, "DIVIDE" :K=K 

+1 
825 INPUT"WHAT IS THE NEXT LINE" ;A: IFA="30=N"THENPRINTCRELSEPRINTCW, "30=N" :K=K+1 
830 PRINT"NOW TRY ONE BY YOURSELF AND GIVE ME THE FINAL ANSWER. ": INPUT"80 IS 40 

PERCENT OF WHAT NUMBER? N=" ; A: B="200" : IFA=BTHENPRINTCR:GOSUB880ELSEPRINTC 

W;"200":K=K+1:GOSUB880 
835 IFK=4THENPRINTCT;" I CAN'T HELP THIS STUDENT. ":GOSUB880 
840 F0RN=1T05:V=RND(NU) :W=RND(NY) :CLS:PRINTN,V; " IS ";W;" PERCENT OF WHAT NUMBER 

?":V=V*P/W:B=STR$(V) :B=MID5(B,2,6) :INPUT"WHAT IS YOUR ANSWER. USE ONLY 5 DI 

GITS. DO NOT ROUND. ";A 

845 IFA=CTTHEN85ELSEIFA=BTHENPRINTCR;CM:PR=PR+L:GOSUB880ELSEPRINTCW;CM,B:GOSUB88 


850 NEXT:PRINT@256,C1;PR*2;C2:PRINTC3;CT;C4:GOSUB880 
855 GOT085 
860 F0RN=1T0L:V=RND(NU):W=RND(NY) :CLS:PRINTN,V; " IS ";W;" PERCENT OF WHAT NUMBER 

?":V=V*P/W:B=STR$(V]:B=MID$(B,2,6) :INPUT"WHAT IS YOUR ANSWER. USE ONLY 5 DI 

GITS. DON'T ROUND.";A:IFA=CTTHEN85 
865 IFA=BTHEN PRINTCR; CM:PR=PR+L:GOSUB880ELSEPRINTCW;CM,B:GOS0B880 
870 NEXTN:PRINT6256,C1;PR;C2:IFPR>=60THENOB(NA,6)=PR:GOSUB880ELSE800 
875 GOT085 

880 FORO=0TOP : A=" " : A=INKEYS : I PA- " "THENNEXTELSERETURN 
885 IFT=0THENPRINTS233, "REMEMBER, PUSH ' ENTER' ." :PRINT@297 ,CHR$ (30) :T=L:GOTO880 : 

ELSEPRINT6297,"PUSH 'ENTER', PLEASE. "; : T=0:GOTO880 
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890 A="":A=INKEY$:IFA=""THEN890ELSERETURN 

895 CLS:PRINTCHR$(23):PRINTe532, "PERCENT I":GOSUB890 

900 RETURN 

905 REM 

940 A="":A=INKEY$:IFA=""THEN905ELSE85 

945~CLS-PRINT"WHAT'S YOUR CHOICE?" : PRINT: PRINT" A STUDENT BY NAME","1" :PRINT:PRIN 

T"ALL STUDENTS",, "2" : PRINT: PRINT "RETURN TO STUDENT START" , "3" :PRINT:PRINT"E 

RASE ALL OF S RECORD", "4" :INPUTI:ONIGOTO950, 955 ,85,950 
950 CLS:INPUT"WHICH STUDENT DO YOU WANT (LAST NAME COMMA FIRST NAME) iCN,CM 
lis FORN:0T5NB:IF(CN=CN{N))AND(CM=CM(N))OR(I=2)THENPRINTCN(N),CMN ,OBN,0 ,OB(N 

,1),OB(N,2),OB(N,3),OB(N,4),OB(N,5),OB(N,6),"NR TURNS ";NT(N) :U=(N+1)/5:V= 

iNT(U):IFI=4THENCN(N)=";CM(N)="":NT(N)=0:FORM=0TO6:OB(N,M)=0:NEXTM:ELSEIFU 

=VTHENGOSUB890 
960 NEXT:GOSUB890 
965 GOT0945 

970 CLS:INPUT"READY TO PRINT*";A:IFAOCYTHEN85 
975 PRINT*-1,CT,NB,NZ,NY,NX,NW,NV,NU 

985 PRINtH^WNWCMIN) ,OB(N,0) ,OB(N,l) ,OB(N,2) ,OB(N,3) ,OB(N,4) '°B(N,5> ,OB(N,6) 
,NT(N),CN(N+l),CM(Nil),OB(N+l,0),OB(N+l,l),OB(N+l,2),OB(Nrt,3),OB(N+l,4),OB 

(N+1,5) ,OB(N+l,6) ,NT(N+1) 
990 NEXT 

995 PRINT"ALL IS PRINTED. ":GOSUB880 
X000 GOT085 



VIDEO READING TRAINER: by Rod Hallen 



With this program your 
TRS-80 becomes the electronic 
equivalent of the old-fashioned 
flash card. It will drill you 
unmercifully, just as Miss Gibbs 
used to do in reading class. Ran- 
dom letter and number groups 
are flashed for varying duration 
of time on the video terminal. 
The user must input the 
equivalent symbols to prove 
recognition. Character group 
sizes and flash period durations 
are variable. 




40 CLS:DIMAS(26):B5=" ":T=1000 

50 A$="ABCDEFGHIJKLMNOPQRSTUVWXYZ" 

60 PRINTe74,"* 

65 PRINT§213, "VIDEO READING TRAINER" 

70 PRINT6401,"PART 1 (NUMBERS AND LETTERS)" 

80 PRINTS528,"(C) COPYRIGHT 1978 ROD HALLEN" 

90 PRINT6650,"* " 

100 FOPJ=1TO2000:NEXTJ:CLS 

110 PRINT8404, "NUMBER OF DIGITS " ; : INPUTU: IFU=0THENEND 

120 IFU>6THENU=6 

130 CLS:PRINT6404, "INITIAL SPEED "; : INPUTY:CLS 

140 IFY>100THENY=100 

150 IFY<10THENY=10 

160 Y1=Y 

170 FORK=1TO1000 
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180 CLS:GOSUB440 

181 PRINT8343,CHK$(151);:FORQ=lT014:PRIWrCHRS(131);:NEXTQ:PRINTCHRS(171); 

182 PRINT8407 ,CHR$ (149) ; :PRINT8422 ,CHRS (170) , 

183 PRINT8471,CHR$(149);:PRIl)Te486,CHRS(170)! 

184 PR1OT§535,CBR$(181);:F0RQ=1TO14:PRIOTCHR$(176);:HEXTQ:PRINTCHR$(186): 
190 R=0:IFK/2<>INT(K/2)THENFORJ=1TO1500:NEXTJ 

200 PORI=1TO20 

210 IFK/2=INT(K/2)THENGOSUB560ELSEGOSUB460 

218 PRiNT8407,CHR$U49);" "(CHRSU70); 

220 PRINT8471,CHR$(149);" ";CHRS(170); 

230 FORP=1TO500:NEXTP:IFR=10THENI=20 

240 NEXTI 

250 IFR=10THEN300ELSEYl=Yl-20 

260 IFYK10THENYlil0 

270 PRINT8198,"THIS APPEARS TO BE A LITTLE TOO PAST FOR YOU." 

280 PRINT8335, "LET'S SLOW IT DOWN A BIT." 

290 FORP=1TO2000:NEXTP:GOTO180 

300 IFK/2=INT(K/2)THENY1=Y1+10 

310 IFYK=100THEN370 

320 IFD=8THEN410 

330 CLS:PRINT6259, "CONGRATULATIONS I YOU ARE MOVING UP TO THE NEXT PLATEAU " 

340 PRINT8393,"YOU WILL NOW BE SEEING";U+1; "CHARACTERS AT A TIME." 

350 PRINT8536,"ARE YOU READY ";: INPUTC$:IFLEFT$(C$,1) ="N"THEN390 

360 U=U+1:Y=Y-10:Y1=Y 

370 NEXTK 

390 CLS:PRINT8396,"YOUR SPEED WITH" ;U; "DIGITS IS NOW";Y1-10; ". " 

400 PRINT8517, "AFTER YOU REST UP, SEE IF YOU CAN'T IMPROVE ON THAT. " :GOTO420 

410 PRINT8458,"YOU HAVE COMPLETED PART 1. GO ON TO PART 2." 

420 PRINT:PRINT:PRINT:END 

440 PRINT825, "SPEED =";Y1:RETURN 

450 REM*-RANDOM NUMBER GENERATOR SUBROUTINE-* 

460 X=INT(RND(0)*10[U-1) 

470 IFX<(10[U-1)/10THEN460 

480 PRINT8414-U/2.X; 

490 FORJ=lTOT/Yl:NEXTJ 

500 PRINT8410," "; 

510 FORP=1TO250:NEXT:PRINT8413-U/2,;:INPUTZ:IFZ=0THEN390 

520 IFX=ZTHBNR=R+1:RETURN 

530 PRINT§471,CHRS(149>,-:PRINT8477-U/2,"*";X,-"* "; :PRINT8486,CHR$ (170) ; :FORP=lTO 

1000:NEXTP 
540 PRINT8472," ";:RETURN 

550 REM*-RANDOM CHARACTER GENERATOR SUBROUTINE-* 
560 B$="" 
565 FORM=1TOU 

570 X=RND(26) lB$=B$+MID$(AS,X,l) 
580 NEXTM 

590 PRINT8415-U/2,B$; 
600 PORJ=lTOT/Yl:NEXTJ 
610 PRINT8410," "; 

620 PORP=1TO250:NEXTP:PRINT8413-U/2,;:INPUTZ5:IFZ$="0"THEN390 
630 IFZ5=B$THENR=R+1: RETURN 
640 PRINT8471,CHR$(149);:PRINT8478-U/2,"* ";B$,-" *"; :PRINT8486,CHR$ (170) ; :FORP=l 

TO1000:NEXTP 
645 PRINT8472," 
650 RETURN 
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MATH HELP: by Ted Carter 

More practice on math basics 
with emphasis put on speed and 
accuracy. Five levels of difficulty 
available. 



TO GOT HB Mi RIGHT' 
. Dfltt (1.2.14 F« ♦.-;*/)''. 



100 


CLS 


110 DIMA(15) 


120 


PRINTS 140,"**** HATH PI 


130 


PRINTS 278, "1 = ADDITION" 


140 


PRINTS 342, "2 = SUBTRACTION" 


150 


PRINTS 406, "3 = MULTIPLICATION 1 


160 


PRINTS 470, "4 = DIVISION" 


170 


PRINTS 602, "WHICH"; : INPUTL 


177 


IF (L<1)OR(L>4)THEN100 


180 


ON L GOTO1000, 2000, 3000, 4000 


1000 


REM ADDITION 


1002 


CLS:Q=0 


1004 


PRINTS 150, "A D D I T I N" 


1006 


GOSUB 8800 


1008 


GOSUB9000 


1010 


GOSUB 8000 


1012 


G5="+" 


1015 


FOR P=0 TO 3 


1020 


PRINTS 326+P*16,A(P) 


1030 


NEXTP 


1040 


FORP=0TO3 


1050 


PRINTS388+P*16,GS;" \-A(P+4) 


1055 


A(12+P)=A(P)+A(P+4) 


1060 


NEXTP 


107 2 


GOSUB 1076 


1074 


GOT01182 


1076 


REM DRAW LINE 


1080 


Y=22 


1090 


FOR P=0 TO 3 


1100 


M=P*32+10 


1110 


FOR X=M TO M+10 


1120 


SET(X,22) 


1130 


NEXTX 


1140 


NEXTP 


1145 


RETURN 


1182 


GOSUB 1190 


1184 


GOTO1240 


1190 


FOR P=0 TO 3 


1200 


N=P*16+518 


1210 


PRINTS N,""; 


1220 


INPUTA(P+8) 


1230 


NEXTP 


1235 


RETURN 


1240 


GOSUB 1246 


1242 


GOTO1360 


1246 


REM RIGHT/WRONG 


1248 


FOR P=0 TO 3 


1260 


IF A(P+8)=A(P+12) GOTO1300 


1265 


IF A(P+8)=A(P+4) GOTO1300 


1270 


PRINTS 582+P*16, "WRONG" 


1280 


GOTO1350 


1300 


PRINTS 582+P*16, "RIGHT" 


1310 


Q=Q+1 


1350 


NEXTP 



R A C T I C E 
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1355 RETURN 

1360 IF Q=4 GOTO1400 

1370 PRINT8730,"TRY AGAIN!" 

1380 PRINTTAB(18) "HIT 'ENTER' TO CONTINUE.. 

1388 INPUTA$ 

1390 GOTO180 

1400 PRINTS 911, "YOU GOT THEM ALL RIGHT1 " 

1402 PRINTS 973, "ENTER (1,2,3,4 FOR +,-,X,/)" 

1410 INPUTL 

1420 GOTO180 

2000 REM SUBTRACTION 

2002 CLS 

2004 PRINTS147,"S UBTRACTION" 

2006 Q=0 

2008 G$="-" 

2010 GOSUB 8800 

2020 GOSUB9000 

2030 GOSUB 8000 

2032 FOR P=0 TO 3 

2034 A(12+P)=A(P)+A(P+4) 

2036 PRINTS 326+P*16,A(12+P) 

2040 NEXTP 

2050 FORP=0TO3 

2055 PRINTS388+P*16,G$;" ";A(P) 

2060 NEXTP 

2070 GOSUB 1076 

2190 GOSUB 1190 

2200 GOSUB 1246 

2210 GOTO1360 

2220 END 

3000 REM MULTIPLICATION 

3002 CLS 

3004 PRINTS147,"M ULTIPLICATION" 

3006 Q=0 

3008 GOSUB 8800 

3009 GOSUB9000 

3010 GOSUB 8000 
3015 FOR P=0 TO 3 

3022 PRINTS 326+P*16,A(P) 

3030 NEXTP 

3040 G$="X" 

3050 FOR P=0 TO 3 

3055 A(P+12)=A{P)*A(P+4) 

3070 PRINT6388+P*16,G$;" ";A(P+4) 

3080 NEXTP 

3085 GOSUB1076 

3090 GOSUB 1190 



3100 


GOSUB 1246 




3200 


GOTO1360 




3999 


GOT03999 




4000 


REM DIVISION 




4010 


CLS 




4020 


PRINTS 150, "D I V I S I N" 




4030 


Q=0 




4040 


GOSUB 8800 




4045 


GOSUB9000 




Aden 


DDTwiifl i}n «« 




4060 


GOSUB 8000 




4070 


FOR P=0 TO 3 




4080 


A(P+12)=A(P)*A(P+4) 




4162 


FOR J=P*32+10 TO P*32+24 




4164 


SET(J,22) 




4170 


NEXTJ 




4220 


PRINTS 512+P*16,A(P); 




4230 


PRINTS 518+P*16,A(P+12),- 




4240 


FOR K=0 TO 3 




4245 


M=K+22 




4250 


SET(P*32+10,H) 




4260 


NEXTK 




4290 


NEXTP 




4300 


FOR P=0 TO 3 




4310 


PRINTS 326+P*16,"\- 




4320 


INPUTAIP+8) 




4330 


NEXTP 




4410 


GOSUB 1246 




4420 


GOTO1360 




4999 


GOT04999 




8000 


REM RND 




8010 


FOR P=0 TO 7 




8020 


ON S GOTO8100, 8200, 8300, 8400, 


,85 


8100 


A(P)=RND(5) 




8110 


GOTO8600 




8200 


A(P)=RND(12) 




8210 


GOTO8600 




8300 


A(P)=RND(50) 




8310 


GOTO8600 




8400 


A(P)=RND(99) 
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8410 


GOTO8600 


8500 


A(P)=RND(999) 


8600 


NEXTP 


8610 


RETURN 


8800 


REM SKILL LEVEL 


8810 


PRINTS 339, "SKILL LEVEL (1 TO 5)"; 


8820 


INPUTS 


8822 


IF(S<1)OR(S>5)THEN8810 


8830 


RETURN 


9000 


REH-ERASE 


9010 


PRINT8320 , " " ; : PKINTCHR$ (30) 


9020 


RETURN 


9030 


END 



HIDE 'n SPELL: by Jacob Rusell 



First, identify the misspelled 
word in a group of four words. If 
you're right, your TRS-80 will 
then ask you to type the correctly 
spelled version. There is no 
hiding from the teacher in this 
game, and speed counts, too. An 
excellent choice for English ma- 
jors and computer magazine 
staffers. 



1 




YOUR SCORE 


e 




.. POINTS SCORED 


: 80 •■ ■•. 


A 


CORUSCATE 




B 


RAMIFICATION 




C 


INTERCEDE 




. -".'IT 


PERPOSTEROUS 





15 REM DISPLAY HIDE N' SPELL, DIMENSION ARRAYS, INITILIZE THE ARRAYS. 

20 REM ASK IF THE PLAYER NEEDS INSTRUCTIONS. 

25 CLS :PRINT 8 334,CHR$ (23) ; "HIDE N' SPELL" 

30 CLEAR 30 :DIM W$(60) :DIM MW$(60) :DIM CH(15) :0$="###t" 

35 Pl=60 

40 FOR 1=1 TO PI :READ W$(I),MW$(I) :NEXT I :FOR C-l TO 100 :NEXT C 

45 CLS :PRINT 6 330, "DO YOU NEED INSTRUCTIONS ? (TYPE Y FOR YES, N FOR NO.)" 

50 CN$=INKEYS :IF CNS=" THEN 50 ELSE IF CN$="Y" THEN 60 

55 IF CN$="N" THEN 110 ELSE 50 

60 CLS :PRINT 8 192," FOUR WORDS WILL BE DISPLAYED ON THE SCREEN BESIDE THE" : PR 

INT"LETTERS A, B, C AND D. YOU ARE TO PRESS THE LETTER OF THE" :PRINT"MISSP 

ELLED WORD. IF YOU ARE CORRECT YOU WILL BE ASKED TO SPELL" :PRINT"THE WORD 

CORRECTLY."; 
65 PRINT" THE FASTER YOU FIND THE WORD THE HIGHER" :PRINT"YOUR SCORE. IF YOU FAI 

L TO CORRECT THE WORD YOUR POINTS SCORED" :PRINT"WILL BE HALVED." 
70 PRINT" BECAREFUL, YOU GET ONLY ONE CHANCE TO FIND THE WORD AND ONLY" :PRINT"0 

NE CHANCE TO CORRECT IT. HIT ANY KEY TO START THE GAME." 
80 CN$=INKEYS :IF CN$="" THEN 80 
90 REM INITILIZE PROGRAM VARIABLES. 
95 REM PRINT YOUR SCORE AND POINTS SCORED. 
110 B=0 :SC=0 :RANDOM 
120 CLS :PRINT 8 74,CHR$ (23) ; "YOUR SCORE" :PRINT 6 96, USING OS;SC :PRINT 8 138," 

POINTS SCORED" 
130 REM CANCEL LATE RESPONCES. SET POINTS SCORED TO 100. 
135 REM SELECT 4 WORDS TO BE DISPLAYED. PICK WHICH WORD WILL BE MISS 

PELLED. 
140 CA$=INKEY$ :PS=100 :PRINT 8 164, USING 0?;PS 
150 T=RND(4) :Q1=RND(P1) :I=Q1 

155 IP T=l THEN A$=MW$(I) :AN?="A" :X1=I :GOTO 165 
160 A$=W$(I) 

165 Q2=RND(P1) : IF Q2=Q1 THEN 165 ELSE I=Q2 
170 IF T=2 THEN BS=MW$(I) :ANS="B" :X1=I :GOTO 180 
175 BS=WS(I) 
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188 
185 
190 
195 

200 
205 
210 
215 
220 

23 
235 
240 

250 
260 
270 



34B 

345 

350 
360 
363 
365 
370 

375 
390 
400 
410 
420 
430 
440 
450 
480 
500 
502 
504 
506 
508 
510 
512 
514 
516 
518 
520 
522 
524 
526 
528 
530 
532 
534 
536 
53 8 
540 
542 
544 
546 
548 
550 
552 
554 
556 
558 
560 
562 
564 
566 
56 8 
570 
572 
574 
576 
578 
580 



Q3=RND(P1) :IF Q3=Q1 OR Q3=Q2 THEN 180 ELSE I=Q3 

IP T=3 THEN C$=MW$(I) :AN$="C" :X1=I :GOTO 195 

CS=W$(I) 

Q4=RND(P1) :IF Q4=Q1 OR Q4=Q2 OR Q4=Q3 THEN 195 ELSE I=Q4 

IP T=4 THEN D$=MW${I) :AN$="D" :X1=I :GOTO 210 

D$=WS(I) 

FOR 11=0 TO B :IF CH(I1)=X1 THEN 150 ELSE NEXT II 

B=B+1 :CH(I1)=X1 :I=X1 

PRINT 8 384, "A ";A$ :PRINT 8 448, "B ";B$ :PRINT 8 512, "C ";CS :PRINT 8 576," 

D ";D$ 
REM COUNT DOWN POINTS SCORED. 

REM CHECK FOR CORRECT ANSWER. CHECK FOR CORRECT SPELLING. 
FOR C=l TO 150 :CN$=INKEY$ : IP CN$="" OR CN$>"D" OR CN$<"A" THEN NEXT C ELSE 

IF CN$=AN$ THEN 260 ELSE 300 
PS=PS-10 :PRINT 8 164, USING OS;PS : IF PS>0 GOTO 240 ELSE 340 
GOSUB 400 
PRINT 8 266," CORRECT 1 NOW SPELL THE WORD"; :PRINT 8 N,"";:INPUT WS : IF W$=W$ 

(I) THEN SC=SC+PS ELSE SC=SC+PS/2 :GOTO 290 
PRINT 8 96, USING 0$;SC; :PRINT 8 266,CHRS(31) :PRINT 8 2ff6, "RIGHTI " :FOR C=l 

TO 500 :NEXT C :GOTO 360 
PRINT 8 96, USING 0$;SC; :PRINT 8 164, USING OSiPS/2 :PRINT 8 266,CHR$(30) :PR 

INT 6 266, "SORRY YOU ARE WRONG" :PRINT 6 N,CHRS(30) :PRINT 8 N," ";W$(D : 

FOR C=l TO 1500 :NEXT C :GOTO 360 
PS=0 :PRINT 6 164, USING 0$,-PS :PRINT 8 266,CHR?(31) :PRINT 8 266, "SORRY ";CN 

$;" IS NOT RIGHT" :FOR C=l TO 500 :NEXT C :GOSUB 400 
PRINT 8 266, "THIS IS THE WORD :" :PRINT 8 N," ";W$(I) :POR C-l TO 1500 :NEX 

T C :GOTO 360 
PRINT 8 266,CHRj(31) :PRINT 8 266, "TIME IS UP" IFOR C»l TO 500 :NEXT C :GOSU 

B 400 
PRINT 8 266, "THIS IS THE WORD :" :PRINT 8 N," "jW$(I) :FOR C=l TO 1500 :NEX 

T C 
REM CHECK TO SEE IF GAME SHOULD END. 
IP B<15 AND B<P1 THEN PRINT 8 266,CHRS(31) :GOTO 140 
REM GAME OVER - ROUTINE . 
FOR 11=1 TO B :CH(I1)=0 :NEXT II 
PRINT 8 138,CHRS(31) :PRINT 8 266," GAME OVER" SPRINT 8 384, "TO PLAY HIDE 

N' SPELL AGAIN" :PRINT 6 464, "TYPE Y" 
CNS=INKEY$ :IF CN$="" THEN 375 ELSE IF CNS="Y" THEN 45 ELSE 375 
REM DISPLAY CORRECT ANSWER SUBPROGRAM. 
PRINT 6 266,CHRS(31) 
IP ANS="B" THEN 430 ELSE IF AN$="C" THEN 440 ELSE IF AN$="D" THEN 450 



PRINT 8 384, "A 
PRINT 8 448, "B 
PRINT 8 512, "C 
PRINT 8 576," 



DATA 
DATA 



;AS :N=416 :RETURN 
;BS :N=480 :RETURN 
;CS :N=54 4 : RETURN 
;D$ :N=608 :RETURN 
REM LINE 500 IS THE BEGINNING OF THE DATA STATEMENTS. 
DATA "MAVERICK", "MAVERIK" 
DATA "EVANGELIST", "EVANGULIST" 
DATA "WHEREWITHAL" , "WHEREWITHALL" 
DATA "BAILIWICK " , "BAILEWICK " 
DATA "QUIBBLE", "QUIBLE" 
DATA "CEMETERY", "CEMETARY" 
DATA "MARRIAGE", "MARRAIGE" 
DATA "LIBERTINE", "LIBERTEEN" 
DATA "DENOMINATION" , "DENOMMI NATION" 
DATA "CONTEMPORARY" , "CONTEMPARARY" 
DATA "JARGON", "JARGEN" 

FETTER", "FETER" 

LANYARD" , "LANDYARD" 
DATA "FIGURINE", "FIGUREEN" 
DATA "ORDNANCE", "ORDNENCE" 
DATA "CITADEL", "CITADIL" 
DATA "PAVILION", "PAVELION" 
DATA "ACCOLADE" , "ACOLADE" 
DATA "VIGIL", "VIGEL" 
DATA "PALADIN", "PALIDIN" 
DATA "ACCOUTERMENTS" , "ACOUTERMENTS" 
DATA "HORRENDOUS", "HORENDOUS" 

ILLUSTRIOUS", "ILUSTRIOUS" 

GAUNTLET" , "GANTLET" 

CORRELATE", "CORELATE" 
DATA "SOLICITOUS", "SOLLICITOUS" 
DATA "COPIOUS", "COPEOUS" 

"PREPOSTEROUS" , "PERPOSTEROUS" 

VERACIOUS" , "VIRACIOUS" 
DATA "CAPRICIOUS", "CAPRECIOUS" 
DATA "PORTENTOUS", "PORTENTIOUS" 
DATA "SPONTANEOUS", "SPONTANEIOUS" 
DATA "CRENELATE","CRENOLATE" 
DATA "TIMOROUS", "TIMORIOUS" 

MISCREANT", "MISCREEANT" 

MENDACIOUS" , "MENDACOUS" 

CORUSCATE ", "CORRUSCATE " 

PRECARIOUS", "PRECAREOUS" 
DATA "INIQUITOUS", "INIQUITIOUS" 
DATA "PUNCTILIOUS" , "PUNCTILLIOUS" 

INDIVISIBLE" , "INDIVISABLB" 



DATA 

DATA 
DATA 



DATA 
DATA 



DATA 
DATA 
DATA 
DATA 



DATA 



41 



582 DATA "ATTENDANCE" , "ATTENDENCE" 

584 DATA "CENTIMETER", "CENTEMETER" 

586 DATA "PREDICAMENT", "PERDICAHENT" 

588 DATA " INFALLIBLE", "INFALABLE" 

590 DATA "VALUABLE" , "VALUEBLE" 

592 DATA "PURSUIT" , "PERSUIT" 

594 DATA "POIGNANT", "POIGNENT" 

596 DATA "RAMIFICATION" ,"RAMEPICATION" 

598 DATA "REFLECTOR" , "REFLECTER" 

600 DATA " INVIGORATE", "INVIGERATE" 

602 DATA "REVERENCE", "REVERANCE" 

604 DATA "CLARIFICATION" , "CLAREFICATION" 

606 DATA " INTERCEDE", "INTERSEDE" 

608 DATA "SUPERSEDE" , "SUPERCEDE" 

610 DATA "PROCEED","PROCEDE" 

612 DATA "TANGIBLE", "TANGEBLE" 

614 DATA "RESPONSIBLE", "RESPONSABLE" 

616 DATA "DESPONDENT", "DESPONDANT" 

618 DATA "INDEPENDENCE", "INDEPENDANCE" 
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BUSINESS 



Projected Profits 

Real Estate Analysis 

Order Blank 

Mail List 

Custom Writing Program 

Inventory 

Contractor 

Rough Lumber List 

Surveyor's Program 

Tax Withholding 

Grade Book 

Information Management System 

Cash Register 



G.R. Glau 
Keith Burrowes 
G. Wagner 
Chuck Ross 
J.N. Adams 
Don Allen 
C.J. Stinson 
D. Brickner 
William Dotson 
Cliff DeJong 
Anne Weiss 
George Doss 
John Hamilton 
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PROJECTED PROFITS: by G.R. Glau 



A sales summary program in 
which the user may adjust sales 
figures to display present, as well 
as predicted future revenues. 
Quite useful in times of double 
digit inflation rates and inven- 
tory adjustments. 



1111 «SPhl 

■Br m 



mmz wiet^.HB^\mam!*m&&\ 




1 CLS 

5 GOSUB350B 

10 M0=. 0885 :M1=. 085 :M2=.0668:M3=. 0499 :M4=. 0604 

20 M5=. 07 24: M6=.0998:M7=. 1019 :M8=. 0704 :M9=. 0982 

30 Nl=. 1027 :N2=. 1042 

100 Sl=300000 

110 S2=80000 

111 REM Sl= TOTAL SALES S2= OVERHEAD 
130 S3=210000 

140 S4=S3/S1 

150 REM S4= GROSS COST PERCENTAGE OF SALES 

200 CLS:INPUT" INPUT ANY CHANGE IN SALES (5%= .05)";A 

210 IF A= THEN 250 

220 K4 = SI * (1+A ) 

230 GOTO300 

250 K4=S1 

300 CLS:INPUT"ANY CHANGE IN OVERHEAD (5%= .05) ";B 

310 IFB=0THEN350 

320 K5=S2*(1+B ) 

330 GOTO400 

350 K5=S2 

400 REM NEW SALES = K4; NEW OVERHEAD = K5 

410 CLS: INPUT" INPUT ANY CHANGE IN GROSS COSTS (5%= .05)";C 

420 IFC=0THEN450 

430 K7=S4*(1+C) 

440 GOTO500 

450 K7=S4 

500 REM K7= COST OF SALES % 

510 GOTO2000 

600 CLS:PRINT"MONTH"iTAB(9);"EST SALES"; 

610 PRINTTAB(21); "COST/SALES" ;TAB(33); "GROSS PRFT"; 

620 PRINTTAB(45);"0'HEAD";TAB(57) ; "NET" 

650 PRINT"JAN";TAB(8);J1;TAB(20);P1;TAB(32);L1;TAB(44);G9;TAB(56);G1 

660 PRINT"FEB";TAB(8);J2;TAB(20);P2,-TAB(32);L2;TAB(44);G9;TAB(56) ;G2 

670 PRINT"MAR";TAB{8);J3;TAB(20);P3;TAB(32);L3;TAB(44)!G9;TAB(56);G3 

680 PRINT"APR";TAB(8);J4;TAB(20);P4;TAB(32);L4;TAB(44);G9;TAB(56) ;G4 

690 PRINT"MAY";TAB(8);J5;TAB(20);P5,-TAB(32);L5;TAB(44);G9;TAB(56);G5 

700 PRINT"JUNE";TAB(8);J6;TAB(20);P6;TAB(32);L6;TAB(44);G9;TAB(56) ;G6 

710 PRINT"JULY";TAB(8);J7;TAB(20);P7;TAB(32);L7;TAB(44) ;G9;TAB(56) ;G7 

720 PRINT"AUG";TAB(8);J8;TAB(20);P8;TAB(32);L8;TAB(44);G9;TAB(56) ;G8 

730 PRINT"SEPT";TAB(8);J9;TAB(20),-P9;TAB(32);L9;TAB(44);G9;TAB(56);H0 

740 PRINT"OCT";TAB(8);K1;TAB(20);Q1;TAB<32);E1;TAB(44);G9;TAB(56);H1 

750 PRINT"N0V";TAB(8) ;K2;TAB(20) ;Q2;TAB(32) ;E2;TAB(44) ;G9;TAB(56) ;H2 

760 PRINT"DEC";TAB(8) ;K3;TAB( 20) ;Q3;TAB(32) ;E3; TAB( 44) ;G9;TAB( 56) ;H3 

770 GOSOB3000 

780 PRINT"TOTALS";TAB(8);W8; TAB(20);W7; TAB(32);W9; 

790 PRINTTABI44) ;K5; TAB(561,-G0 

1999 GOT01999 

2000 REM HERE WE'RE GETTING THE MONTHLY FIGURES 

2010 J1=INT(K4*M0) :J2=INT(K4*M1) : J3=INT(K4*M2) : J4=INT(K4*M3) : J5=INT(K4*M4) 

2020 J6=INT(K4*M5) : J7=INT(K4*M6) : J8=INT(K4*M7) : J9=INT(K4*M8 ) 

2030 K1=INT(K4*M9) :K2=INT(K4*N1) :K3=INT(K4*N2) 

2040 W8=INT(J1+J2+J3+J4+J5+J6+J7+J8+J9+K1+K2+K3) 

2050 REM G4 = SALES SS? 

2200 REM COST OF SALES= SALES/MONTH (Jl) * K7 

2210 P1=INT(J1*K7):P2=INT(J2*K7) :P3=INT( J3*K7) :P4=INI(J4*K7) 

2220 P5=INT(J5*K7) :P6=INT(J6*K7) :P7=INT( J7*K7) :P8=INT(J8*K7) 
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2238 P9-INT(J9»K7) :Q1-INT(K1*K7) :Q2»INT(K2*K7) :Q3=INT(K3*K7) 

2248 W7-P1+P2+P3+P4+P5+P6+P7+P8+P9+Q1+Q2+Q3 

268B G9-INT(K5/12) 

278B G1=J1-P1-G9:G2=J2-P2-G9:G3=J3-P3-G9:G4=J4-P4-G9:G5=J5-P5-G9 

271B G6=J6-P6-G9:G7=J7-P7-G9:G8=J8-P8-G9 

272B H8=J9~P9-G9:Hl=Kl-Ql-G9:H2=K2-Q2-G9:H3=K3-0.3-G9 

275B GB=G1+G2+G3+G4+G5+G6+G7+G8*HB+H1+H2+H3 

2880 REH Ll= GROSS S$ 

2818 L1=J1-P1:L2=J2-P2:L3=J3-P3:L4=J4-P4:L5=J5-P5:L6=J6-P6:L7=J7-P7:L8=J8-P8 

282B L9=J9-P9:E1=K1-Q1:E2=K2-Q2:E3=K3-Q3 

2825 L1=INT(L1) :L2=INT(L2) :L3=INT(L3) :L4=INT(L4) :L5=INT(L5) :L6=INT(L6) 

2826 L7=INT(L7) :L8=INT(L8) :L9=INT(L9> :E1=INT(E1) :E2=INT(E2) :E3=INT(E3) 
283B W9=INT(L1+L2+L3+L4+L5+L6+L7+L8+L9+E1+E2+E3) 

290B GOT06BB 

3BBB F0RX=1T064:PRINT"-";:NEXTX 

3B1B RETURN 

35BB PRINT"THIS IS A SALES SUMMARY PROGRAM, IN WHICH YOU CAN CHANGE" 

351B PRINT'SALES FIGURES TO NOT ONLY DISPLAY WHAT YOU HAVE DONE," 

352B PRINT"BUT ALSO WHAT THE FUTURE MIGHT BRING." 

353B PRINT 

354B PRINT'TO CHANGE ANY OF THE FIGURES (SALES, OVERHEAD, GROSS COST)," 

3550 PRINT"ANSWER THE QUESTIONS. REMEMBER THAT TO DECREASE A FIGURE," 

356B PRINT'JUST PUT A MINUS SIGN BEFORE YOUR ANSWER. FOR EXAMPLE:" 

3570 PRINT" .85 MEANS YOU WANT TO INCREASE THE FIGURE BY 5%, AND" 

3588 PRINT" -.07 MEANS YOU WANT TO DECREASE THE FIGURE BY 7%." 

3590 PRINT 

36B0 PRINT"NOTE ALSO THAT YOU CAN CHANGE ANY OP THE FIGURES" 

3610 PRINT"IN ANY COMBINATION— RAISE SALES, LOWER OVERHEAD, ETC." 

3628 PRINT 

363B PRINT"HIT ENTER TO CONTINUE ";:INPUTZ 

3648 RETURN 



REAL ESTATE ANALYSIS: by Keith Burrowes 



This program allows the real 
estate professional, or any prop- 
erty owner, to keep track of the 
profitability of investments. The 
myriad of variables concerned 
with real estate investments are 
considered in figuring profitabil- 
ity in this program. A very 
worthwhile program for times of 
tight money and high interest 
rates. 





IB CLS 

28 CLEAR5BB 

30 DEFINTX,N,Q 

48 DIM A(5),SP(5),CP(5),TG(5),GP(5),YD(5),D(50),SC(5B),SD(5B) 

5fl PRINTTAB(10)"REAL ESTATE ANALYSIS PROGRAM" 

55 Z=0 

60 PRINT 

7B INPUT" PROPERTY STREET ADDRESS"! AS 

80 INPUT"CITY";B5 

98 INPUT-NUMBER OF UNITS", -X 

100 PRINT 

110 PRINT'INCOME DATA :" 

12B INPUT"GROSS MONTHLY INCOME ",-R 

130 INPUT"VACANCY ALLOWANCE IN DECIMAL FORM ",-V 

140 PRINT 
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150 PRINT-EXPENSE DATA :" 

160 INPUT"PROPERTY TAXES" ;PT 

165 INPUT"UTILTIES";UT 

170 INPUT"INSURANCE";IS 

180 INPUT"MAINTENANCE";MT 

190 INPUT"GARDENING";GN 

200 INPUT-MANAGEMENT" ;MG 

210 OE=PT+UT+IS+MT+GN+MG 

220 RN=12*R*(1-V)-0E 

230 PRINT 

240 INPUT"CORRECTIONS (YES OR NO)";CS 

250 IF CS="NO" THEN 290 

260 IF CS="YES" THEN 100 

270 PRINT"ENTER YES OR NO" 

280 GOTO240 

290 PRINT 

295 IF ZO0 THEN 810 

300 PRINT"PURCHASE DATA :" 

310 INPUT"PURCHASE PRICE" ; PP 

320 INPUT"ONE TIME COSTS";OC 

330 INPUT"FIRST MORTGAGE AMOUNT";Fl 

340 INPUT" INTEREST IN DECIMAL FORM ";I1 

350 INPUT"IS FIRST MORTGAGE PAYMENT STIPULATED";D$ 

360 IF DSO"YES" THEN 390 

370 INPUT"FIRST MORTGAGE PAYMENT AMOUNT";Pl 

3 80 GOTO 410 

390 P1=0 

400 INPUT"FIRST MORTGAGE PERIOD IN YEARS ";Y1 

410 INPUT"ANY SECOND MORTGAGE (YES OR NO)";I$ 

420 IF IS="YES" THEN 480 

430 IF I?="NO" THEN 460 

440 PRINT"ENTER YES OR NO" 

450 GOTO 410 

460 F2=0:I2=0:P2=0:Y2=0:I4=0:B2=0 

47 GOTO560 

480 INPUT'SECOND MORTGAGE AMOUNT";F2 

490 INPUT" INTEREST IN DECIMAL FORM";I2 

500 INPUT"IS SECOND MORTGAGE PAYMENT STIPULATED" ;E$ 

510 IF E$<>"YES" THEN 540 

520 INPUT'SECOND MORTGAGE PAYMENT AMOUNT", -P2 

530 GOTO560 

540 P2=0 

550 INPUT-SECOND MORTGAGE PERIOD IN YEARS" ;Y2 

560 PRINT 

565 IF ZO0 THEN 810 

570 PRINT-TAX RELATED DATA :" 

580 INPUT-VALUE OF BUILDING FOR DEPRECIATION", -BG 

590 INPUT-REMAINING USEFUL LIFE IN YEARS", -L 

600 INPUT-SALVAGE VALUE OF BUILDING";SV 

610 PRINT 

620 PRINT-FOR DEPRECIATION METHOD ENTER NUMBER AS FOLLOWS:" 

630 PRINT 

640 PRINT"STRAIGHT LINE = 1" 

650 PRINT"125% DECLINING BALANCE = 2" 

660 PRINT-150% DECLINING BALANCE - 3" 

670 PRINT-200% DECLINING BALANCE = 4" 

680 PRINT 

690 INPUT-YOUR CHOICE" ;D 

695 IF 2<>0 THEN 810 

700 PRINT 

710 PRINT'INVESTOR'S DATA :" 

720 INPUT"MOST LIKELY APPRECIATION RATE (DECIMAL FORM)";A(3) 

730 INPUT"MINIMUM EXPECTED APPRECIATION RATE (10% CHANCE) ";A(1) 

740 INPUT-MAXIMUM EXPECTED APPRECIATION RATE (10% CHANCE) " ;A(5) 

750 A(2)=(A(l)+A(3))/2 

760 A(4)=(A(3)+A(5))/2 

770 INPUT-NUMBER OF YEARS INVESTMENT WILL BE HELD";N 

790 INPUT'BROKER'S SALES COMMISSION IN DECIMAL FORM";BR 

800 INPUT-COMBINED FEDERAL S STATE TAX BRACKET (DEC. FORM)";T 

810 GOSUB 5000 

820 GOSUB 6000 

830 'PRINT TITLES 

840 LPRINT 

850 LPRINT-REAL ESTATE INVESTMENT ANALYSIS" 

860 LPRINT"OF AN INVESTMENT IN A" 

870 IF X=l THEN 900 

880 LPRINTX;"UNIT STRUCTURE AT" 

890 GOTO910 

900 LPRINT"SINGLE FAMILY DWELLING AT" 

910 LPRINTA$ 

920 LPRINTBS 

930 LPRINT 

940 LPRINT'PROPOSED COST PRICE $";PP+OC 

950 LPRINT'FIRST MORTGAGE AT",-100*I1; "%" ;TAB(34) "S";F1 

960 IF I$="NO"THEN 980 

970 LPRINT'SECOND MORTGAGE AT" ,-100*12; "%" ;TAB(34) "$" ;F2 

980 LPRINT'TOTAL CASH OUTLAY FOR PURCHASE $" ;PP+OC-Fl-F2 
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990 LPRINTiLPRINT 

1000 PRINT"SELECT ANALYSIS SEGMENT YOU WISH :" 

1010 PRINT-FOR ANNUAL CASH FLOW TYPE 1" 

1020 PRINT'FOR GROSS MULTIPLIER TYPE 2" 

1030 PRINT'FOR FIRST YEAR YIELD TYPE 3" 

1040 PRINT'FOR YIELD AFTER SALE TYPE 4" 

1050 PRINT'TO ENTER NEW DATA OR STOP TYPE 5" 

1055 PRINT 

1060 INPUT"YOUR CBOICE";S 

1070 ON S GOTO 1150,2000,2300,2600,1075 

107 5 PRINT 

1080 INPUT-DO YOU WISH TO ENTER NEW DATA FOR THIS PROPERTY" iCS 

1090 IF CSO'YES'THEN END 

1100 PRINT 

1105 PRINT-TO CHANGE PARAMETERS BELOW, TYPE NUMBER INDICATED" 

1110 PRINT'FOR INCOME S, EXPENSE DATA ONLY, TYPE 1" 

1115 PRINT-FOR PURCHASE DATA ONLY, TYPE 2" 

1120 PRINT"FOR TAX RELATED DATA ONLY, TYPE 3" 

1125 PRINT'FOR INVESTOR'S DATA ONLY, TYPE 4" 

1130 INPUT'YOUR CHOICE- ;Z 

1135 ON Z GOTO 100,300,570,700 

1150 LPRINT"ANNUAL CASH FLOW ANALYSIS" 

1160 LPRINTSTRING?(25,"-") 

1170 LPRINT 

1180 LPRINTTABU0) "ANNUAL CASH FLOW - BEFORE INCOME TAX" 

1190 LPRINT 

1200 LPRINT'ANNUAL INCOME :" 

1210 LPRINT 

1220 LPRINT"GROSS ANNUAL RENTS S";12*R 

1230 LPRINT"LESS VACANCY ALLOWANCE AT" ;100*V: "%" ;TAB(35 ) ■$" : INT (V*12*R+ 5) 

1240 LPRINT"NET ANNUAL INCOME $" ; INT(12*R* (1~V) + 51 ' 

1250 LPRINT ( U V,+ - 3 ' 

1260 LPRINT-ANNUAL OPERATING EXPENSES :" 

1270 LPRINT 

1280 LPRINT'PROPERTY TAXES S"-PT 

1290 LPRINT"UTILITIES S"JuT 

1300 LPRINT" INSURANCE $"-IS 

1310 LPRINT"MAINTENANCE S"'-MT 

1320 LPRINT-GARDENING S"-GN 

1330 LPRINT"MANAGEMENT 5»: hg 

1340 LPRINT"PAYMENT ON FIRST MORTGAGE S" ; INT(12*P1+ 5) 

1350 IFI$="NO" THEN 1370 

1360 LPRINT"PAYMENT ON SECOND MORTGAGE $" ; INT(12*P2+ 5) 

1370 LPRINT-TOTAL OPERATING EXPENSES S" ; INT(OE+12* (P1+P2) +.5) 

13 80 LPRINT 

1390 LPRINT'OPERATING CASH FLOW BEFORE TAXES S" ; INTIRN-12* (P1+P2) + 5) 
1400 LPRINT |riT«|T. = j 

1410 LPRINT"NOTE:YOUR GROSS MONTHLY INCOME (IGNORING VACANCIES) IS $";R 

1420 LPRINT" FIRST MORTGAGE MONTHLY PAYMENT IS $"-INT(Pl+ 5) 

1430 IF IS="NO" THEN 1450 ' l '" 

1440 LPRINT" SECOND MORTGAGE MONTHLY PAYMENT IS $"!lNT(P2+ 5) 

1450 LPRINT" MONTHLY AVERAGE OF OTHER EXPENSES IS S" ■ INT(OE/12+ 

1460 LPRINT- NET MONTHLY CASH FLOW (IGNORING VACANCIES) IS $" ; INTIR-P1-P 

2-OE/12+.5) 
1470 LPRINT 
1480 IF R<(P1+P2+0E/12) THEN LPRINT"NOTE THAT INCOME IS LESS THAN EXPENSES" 

14 90 LPRINT 

1500 LPRINTTABU0) "ANNUAL CASH FLOW - AFTER INCOME TAX" 

1510 LPRINT 

1520 LPRINT"NET ANNUAL INCOME $" ; INT (12*R* (1-V) + 5) 

1530 LPRINT l ( VI1-.SJ 

1540 LPRINT"ANNUAL OPERATING EXPENSES $";OE 

1550 LPRINT" INTEREST EXPENSE, FIRST YEAR $";INT(I3+I4+ 5) 

1560 LPRINT-ONE TIME EXPENSES, FIRST YEAR $";OC 

1570 LPRINT"DEPRECIATION, FIRST YEAR S" ; INT(D1+. 5) 

1580 LPRINT'TOTAL DEDUCTIBLE EXPENSE $",- INT(OE+I3+I4tOC+Dl+ 5) 

1590 LPRINT .iniiuwiwHtw.tun.s) 

1600 LPRINT-FIRST YEAR TAXABLE INCOME $" ; INT (RN-I3-I4-OC-D1+ 5) 
1610 IF (R*12*(l-V))>(I3+I4+OE+OC+Dl) THEN 1700 

1620 LPRINT"OTHER INCOME SHELTERED BY $";INT(I3+I4+0C+D1-RN+ 5) 
1625 LPRINT iinnufHmwi kni-,3) 

1630 LPRINT"AT";100*T;-» TAX BRACKET, TAX BENEFIT IS S",-INT(T* (I3+I4+OC+D1-RN) + . 

1640 LPRINT 

1650 LPRINT'SPENDABLE CASH, INCLUDING SHELTER IS $" ; INT(RN-12* (P1+P2) +T* (I3+I4+0 

C+D1-RNJ+.5) 
1660 GOTO17 40 

1710 LPRINt" FIRST YEAR TAX ^ $",-INT(T*(RN-I3-I4-OC-Dl)f.5) 

1720 LPRINT'SPENDABLE CASH AFTER TAX IS S" , INT(RN-12* (P1+P2) -T* (RN-I3-I4- 

OC~Dl)+.5) 
1740 LPRINT 

1750 LPRINT" IN ADDITION TO THE ABOVE, THE MORTGAGE BALANCES HAVE BEEN REDUCED BY 
$";INT(12*(Pl+P2)-I3-I4+.5) 

1754 LPRINT 

1755 LPRINT-DEPRECIATION METHOD USED WAS ";F$ 



47 



1756 LPRINT'DEPRECIABLE BUILDING VALUE - $";BG;"WITH A";L;"YEAR LIFE" 

1757 IP DOl THEN176B 

175B LPRINT" SALVAGE VALUE - $";SV 

1760 LPRINTsLPRINT 

1770 G0T01BBB 

20BB LPRINT'GROSS MULTIPLIER" 

2B1B LPRINTSTRING$(16,"-") 

?fl?B T PRINT 

2MB LPRINT"COST PRICE IS";INT< ( (PP+0C)/(12*R) ) »1B0+. 51/100; "TIMES ANNUAL GROSS. 

2040 LPRINTiLPRINT 

205B GOTO 18B0 

2380 LPRINT'FIRST YEAR YIELD" 

231B LPRINTSTRING$(16,"-") 

919PI T PRINT 

2330 LPRINT"TAKING INTO ACCOUNT SPENDABLE DOLLARS PLUS TAX" 

2348 LPRINT'SBELTER, IF ANY, AND REDUCTION IN MORTGAGE PRINCIPAL," 

235B LPRINT"YOUR GAIN AFTER INCOME TAX IS S" ;INT(RN-T*(RN-I3-I4-OC-Dl)-I3-I4+.5> 

236B LPRINT'THIS REPRESENTS AN AFTER TAX YIELD ON AN INVESTMENT" 

2370 LPRINT"OF $";PP+OC-Fl-F2; "OF"; INK ( (RN-TMRN-I3-I4-OC-D1) -13-14 >/<PP+OC-Fl- 

F2))*lBB+.5);"% FIRST YEAR." 
238B LPRINT-IF THE MORTGAGE REDUCTION IS EXCLUDED, TBE FIRST" 
2390 LPRINT-YEAR-S CASB YIELD IS";INT( ( (RN~12*(P1+P2)-T« (RN-I3-I4-OC-D1) )/(PP+OC 

-F1-F2))*10B+.5);"S." 

2410 LPRINT'NOTE: ONE TIME COSTS OF $*;OC;"THE FIRST YEAR," 

2420 LPRINT"YIELDED A NON-RECURRING TAX BENEFIT OF $";T*OC 

2430 LPRINT:LPRINT 

244B GOTO1BB0 

260B LPRINT"YIELD AFTER EVENTUAL SALE" 

261B LPRINTSTRING$(25,"-") 

2620 LPRINT 

2630 LPRINT"ASSUMPTIONS :" 

2640 LPRINT'YOU BUY AT A TOTAL COST PRICE OF $";PP+OC; "AND" 

2650 LPRINT'HOLD THE PROPERTY POR";Nl "YEARS. THE "iFS 

2660 LPRINT"DEPRECIATION METHOD WAS USED WITH A USEFUL LIFE OF";L 

2670 LPRINT'YEARS. THE AMOUNT TO BE DEPRECIATED IS $";BG;"." 

26 80 LPRINT"RATHER THAN USE A SINGLE VALUE FOR APPRECIATION, A" 

26 90 LPRINT"RANGE IS USED FOR SENSITIVITY ANALYSIS AS SHOWN BELOW." 
2700 LPRINT:LPRINT 

2710 LPRINT'RESULTS :":LPRINT 

2720 GS=" #♦« #*# »** *»* »**" 

2730 HS="$$tS,HS $$##,#»« $$##,#*# $$»t,MS $$##,#«" 

2740 LPRINT"ANNUAL APPRECIATION RATE(%)"; 

2750 LPRINTTAB(30); 

2760 LPRINT USING G$; A(l) *100,A<2) *100,A<3) *100,A<4) *100,A(5) *100 

2770 LPRINT"ESTIMATED PROBABILITY (%)" ; 

27 80 LPRINTTAB(30) ; 

2790 LPRINT USING G$;10 ,20,40 ,20,10 

27 95 LPRINT 

28B0 LPRINT'EXPECTED SALES PRICE"; 

2810 LPRINTTAB(3 0); 

2820 FOR Q=l TO 5 

2830 SP(Q)=PP*U+A(Q)) [N 

2840 NEXT Q 

2850 LPRINT USING H$;SPiD ,SP(2) ,SP{3) ,SP(4) ,SP(5) 

2860 LPRINT"LESS SALES EXPENSE"; 

2870 LPRINTTAB(30); 

2880 LPRINT USING H$;BR*SP(1) ,BR*SP(2) ,BR*SP(3) ,BR*SP{4) ,BR*SP(5! 

2890 LPRINT"LESS FIRST MORTGAGE BALANCE"; 

2900 LPRINTTAB(30); 

2910 LPRINT USING HS;B1 ,B1,B1 ,B1,B1 

2920 IF I?="NO" THEN 2960 

2930 LPRINT"LESS SECOND MORTGAGE BALANCE"; 

2940 LPRINTTABI30) ; 

2950 LPRINT USINGH?;B2,B2,B2,B2,B2 

2960 LPRINT'NET CASH PROCEEDS FROM SALE"; 

2970 LPRINTTAB(30); 

2980 FOR Q=l T05 

2990 CP(Q)=SP(Q)*(1-BR)-B1-B2 

3000 NEXT Q 

3010 LPRINT USING HS;CP (1) ,CP{ 2) ,CP (3) ,CP ( 4) ,CP (5) 

3020 LPRINT 

3030 LPRINT'LONG TERM CAPITAL GAINS:" 

3040 LPRINT"BEGINNING BOOK VALUE"; 

3050 LPRINTTAB130); 

3060 LPRINT USING HS;PP,PP,PP,PP,PP 

3070 LPRINT'LESS ACCUMULATED DEPREC"; 

3080 LPRINTTAB(30); 

3090 LPRINT USING H$;D2,D2,D2,D2,D2 

3100 LPRINT'ENDING BOOK VALUE"; 

3110 LPRINTTAB(30) ; 

3120 LPRINT USING H$;PP-D2,PP-D2,PP-D2,PP-D2,PP-D2 

3130 LPRINT"TAXABLE GAIN ON SALE"; 

3140 LPRINTTAB(30); 

3150 FOR Q=l TO 5 

3160 TG(Q)=SP(Q)*(1-BR)-{PP-D2) 
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317 NEXT Q 

3188 LPRINT USING H$;TG(1) ,TG(2) ,TG(3) ,TG(4) ,TG(5) 

3190 LPRINT"40% LONG TERM CAP GNS TAX"; 

3200 LPRINTTAB(30); 

3210 LPRINT USING H$j .4*TG(1) *T, .4*TG(2) *T, .4*TG(3) *T, .4*TG(4) *T, .4*TG<5) *T 

3220 LPRINT:LPRINT:LPRINT 

3230 'CALC OF EFFECT OF ANNUAL CASH FLOW ON YIELD 

3240 SC(1)=RN-12*(P1+P2)-T*(RN-I3-I4-0C-D1) 

3250 'SUBSEQ VRS EXCL T*OC. 13 S 14 REDUCE AN AV OF 10%. 

3260 FOR Q=2 TO N 

3270 SC(Q)=SC(l)-T*OC-.l*T»(I3+I4) 

3290 NEXT Q 

3310 SC=0 

3320 FOR 0= 1 TON 

3330 SC=SC+SC(Q) 

3340 NEXTQ 

3350 LPRINT'OVERALL YIELD:" 

3360 LPRINT'CASH GAIN AFTER TAX (NOTE 1)"; 

3370 LPRINTTAB(30); 

3380 FOR 0=1 T05 

3390 GP(Q)=CP(Q)-.4*TG(Q)*T 

3400 NEXT Q 

3410 LPRINT USING HS;GP(1) ,GP(2) ,GP(3) ,GP(4) ,GP(5) 

3420 LPRINT"LESS ORIGINAL CASH OUTLAY"; 

3430 LPRINTTAB(30)j 

3440 Y=PP+0C-F1-F2 

3450 LPRINT USING HS;Y,Y,Y,Y,Y 

3460 LPRINT"NET GAIN AFTER TAX"; 

3470 LPRINTTAB(30); 

3480 LPRINT USING HS;GP(1)-Y,GP(2)-Y,GP(3) -Y,GP(4)-Y,GP(5) -Y 

3490 'CALC OP INTERNAL RATE OF RETURN 

3500 FOR Q=l TO 5 

3510 GOSUB 7000 

3520 YD(Q)=YD(Q)*100 

3525 PRINT'YIELD NUMBBR";Q;" = ";YD(Q);"%" 

3530 NEXTQ 

3540 LPRINT" INTERNAL RATE OF RETURN!*)"; 

3550 LPRINTTAB(30)j 

3560 LPRINT USING GS;YD(1) ,YD(2) ,YD<3) ,YD(4) ,YD(5) 

3570 LPRINT:LPRINT 

3580 LPRINT"EXPECTED YIELD = ";INT(YD(1> *.1+YD(2) *.2+YD(3) *.4+YD(4) *.2+YD(5) *.1+ 

3590 MU=(YD(l)+YD(2)+YD(3)+YD(4)+YD(5))/5 

3600 LPRINT"MEAN OF YIELDS = ";INT(MU+.5) ; "*." 

3610 LPRINT'STD DEVIATION OF YIELDS - " ;INT(SQR( ( (YD{1) -HO) [2+(YD(2) -HU) [2+(YD(3 

)-MU)[2+(YD(4)-MU)[2+<YD(5)-MU)[2)/4)+.5);"t." 
3620 LPRINT 
3630 LPRINT"NOTES :" 

3640 LPRINT'l.TAX WAS COMPUTED USING 40* LONG TERM CAPITAL GAINS RATE." 
3650 LPRINT'THE REMAINING 60* NOT INCLUDED MAY BE SUBJECT TO MINIMUM" 
3660 LPRINT'TAX. FOR THE CASES ANALYSED, THIS AMOUNT RANGES FROM" 
3670 LPRINT"5";INT(.6*TG{l)+.S);"TO $";INT{ .6*TG<5)+.5> ; ". " 
3680 LPRINT"2.THE EFFECT OF THE AFTER TAX ANNUAL CASH FLOW WAS" 
3690 LPRINT" INCLUDED IN THE YIELD CALCULATION." 
3710 LPRINT'THE INTEREST PORTION OF THE MORTGAGE PAYMENTS" 
3720 LPRINT'WAS REDUCED 10* OVER THE PERIOD TO ALLOW FOR THE" 
3730 LPRINT'TAX EFFECT. ON THIS BASIS, THE VALUE OF THE ANNUAL" 
3740 LPRINT"AFTER TAX CASH FLOW IS $";INT(SC+.5) 
3750 IF D=l THEN 3B50 

3760 LPRINT"3.THE USE OF ACCELERATED DEPRECIATION MAY REQUIRE" 
3770 LPRINT"PARTIAL CONVERSION TO ORDINARY INCOME. STRAIGHT LINE" 
3780 LPRINT"DEPRECIATION WOULD HAVE AMOUNTED TO S" ; INT(D3+.5) ; "AFTER";N; "YEARS" 
3790 LPRINT'WHERBAS ACCELERATED DEPRECIATION AMOUNTED TO $" ; INKD2+.5) 
3800 LPRINT'THE DIFFERENCE IS $"; INT(D2-D3+.5) ; ". SALVAGE VALUE = $";SV 
3850 LPRINT:LPRINT 
3860 GOTO1000 

5000 'SUBROUTINE TO CALCULATE MORTGAGE UNKNOWNS 
5005 15=11/12:16=12/12 
5010 IF P1O0 THEN5060 
5020 IF Y1=0 THEN STOP 

5040 P1=F1*( ( I5)/(l- (1/(1+15) [(Yl*12)))) 
5060 IF I$="NO" THEN 5110 
5070 IF P2O0 THEN 5110 
5080 IF Y2=0 THEN STOP 

5100 ?2=F2*( (I6)/(l-(l/(l+I6) ( (Y2*12)) ) ) 
5110 I3=12*P1-((P1/I5)-F1)*( (1+15)112-1) 
5120 Bl=Fl-( (PI/IS) -Fl)*( (1+15) ((12*N)-1) 
5130 IF I$="NO" THEN 5160 
5140 I4=12*P2-((P2/I6)-F2)*((1+I6) [12-1) 
5150 B2=F2-((P2/I6)-F2)*((1+I6)[(12*N)-1) 
5160 RETURN 

6000 'SUBROUTINE TO CALCULATE DEPRECIATION 
6010 D2=0 

6020 ON D GOTO 6030,6080,6160,6250 
6030 F$="STRAIGHT LINE" 
6040 D1=(BG-SV)/L 
6050 D3=((BG-SV)/L)*N 
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6055 D2=D3 

6060 RETURN 

6080 F?="125% DECLINING BALANCE" 

6090 FOR Q=l TO N 

6100 D(Q)=((BG-D2)/L)*1.25 

6110 D2=D2+D(Q) 

6120 NEXT Q 

6130 D1=D(1) 

6140 GOTO6050 

6160 F$="150% DECLINING BALANCE" 

6170 FOR 0=1 TON 

6180 D(Q)=((BG-D2)/L)*1.5 

6190 D2=D2+D(Q) 

6200 NEXT Q 

6210 D1=D(1) 

6220 GOTO6050 

6250 FS="200% DECLINING BALANCE" 

6260 FOR Q= 1 TO N 

6270 D(Q)=((BG-D2)/L)*2 

6280 D2=D2+D(Q) 

6290 NEXT Q 

6300 D1=D(1) 

6310 GOTO6050 

7000 ■ SUBROUTIWHAT NUMBER?" : V=V*P/W:B=STR$ (V) :B=MID$ (B, 2 ,6) : INPUT"WHAT IS YOUR A 

NSWER. USE ONLY 5 DIGITS. DO NOT ROUND. ";A 
845 IFA=CTTHEN85ELSEIFA=BTHENPRINTCR;CM:PR=PR+L:GOSUB880ELSEPRINTCW;CM,B:GOSUB88 


850 NEXT:PRINTe256,Cl;PR*2;C2:PRINTC3;CT;C4:GOSUB880 
855 GOT085 
860 F0RN=1T0L:V=RND(NU) :W=RND(NY> :CLS:PRINTN,V; " IS "jW;" PERCENT OF WHAT NUMBER 

?":V=V*P/W:B=STRS(V]:B=MID$(B,2,6) :INPUT"WHAT IS YOUR ANSWER. USE ONLY 5 DI 

GITS. DON'T ROUND.";A:IFA=CTTHEN85 
865 IFA=BTHEN PRINTCR,-CM:PR=PR+L:GOSUB880ELSEPRINTCW;CM,B:GOSUB880 
870 NEXTN:PRINTS256,C1;PR;C2:IFPR>=60THENOB(NA,6)=PR:GOSUB880ELSE800 
875 GOT085 

880 FORO=0TOP:A="":A=INKEY$:IFA=""THENNEXTELSERETURN 
885 IFT=0THENPRINT@233, "REMEMBER, PUSH ' ENTER 1 ." :PRINTS297 ,CHR? (30) :T=L:GOTO880 : 

ELSEPRINTS297,"PUSH 'ENTER', PLEASE. " J :T=0:GOTO880 
890 A="":A=INKEY$:IFA=""THEN890ELSERETURN 
895 CLS:PRINTCHR$(23) :PRINT§532, "PERCENT I":GOSUB890 
900 RETURN 
905 REM 

940 A="":A=INKEY$:IFA=""THEN905ELSE85 
945 CLS:PRINT"WHAT'S YOUR CHOICE?" :PRINT:PRINT"A STUDENT BY NAME" , "1" :PRINT: PRIN 

T"ALL STUDENTS", , "2" :PRINT:PRINT"RETURN TO STUDENT START", "3" :PRINT:PRINT"E 

RASE ALL OF S RECORD", "4" : INPUTI:ONIGOTO950 , 955 , 85 , 950 
950 CLS:INPUT"WHICH STUDENT DO YOU WANT (LAST NAME COMMA FIRST NAME)";CN,CM 
955 FORN=0TONB:IF(CN=CN(N))AND(CM=CM(N))OR(I=2)THENPRINTCN(N),CM(N),OB(N,0),OB(N 

,1) ,OB(N,2),OB(N,3) ,0B(N,4) ,0B(N,5) ,0B(N,6) , "NR TURNS ";NT(N) :U=(N+1)/5:V= 

INT(U) :IFI=4THENCN(N)="":CM(N)="":NT(N)=0:FORM=0TO6:OB(N,M)=0:NEXTM:ELSEIFU 

=VTHENGOSUB890 
960 NEXT:GOSUB890 
965 GOT0945 

970 CLS:INPUT"READY TO PRINT#";A: IFAOCYTHEN85 
975 PRINT#-1,CT,NB,NZ,NY,NX,NW,NV,NU 
980 PORN=0TONBSTEP2 
985 PRINT»-1,CN(N) ,CM(N) ,OB(N,0) ,0B(N,1) ,0B(N,2) ,0B(N,3) ,0B(N,4) ,0B(N,5) ,0B(N,6) 

,NT(N) ,CN(N+1) ,CM(N+1) ,OB(N+1,0) ,0B(N+1,1) ,0B(N+1,2) ,0B(N+1,3) ,0B(N+1,4) ,0B 

(N+1,5) ,0B(N+1,6) ,NT(N+1) 
990 NEXT 

995 PRINT'ALL IS PRINTED. ":GOSUB880 
1000 GOT085 
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ORDER BLANK: by G. Wagner 



This computerized order 
blank system will make record- 
keeping a breeze for the small 
businessman. All types of sales 
data can be entered by keyboard 
with disk storage, providing 
quick access. An ideal choice for 
any mail order operation. 
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EHTEP SUMfmr 1 73. 



ORDER 
'0' FOR QUANTITY 



■NS' FOR NO SUBSTITUTIONS", -AS 



% $###.»# $«###.#«" 



3 CLS : CLEAR 2000 

5 DEFINT I,J,K,L,M,N,Q 

7 DEFSTR A,C,D,F,0 

9 DIM Q(50),CN(50),DS(50),UP(50),AC(50) 

11 PRINT "ORDER BLANK GENERATOR": PRINT 

12 PRINT "NOW WE START TO COMPOSE YOUR 

14 PRINT "TO CLOSE OUT THE ORDER ENTER 

15 PRINT 

16 INPUT "ENTER 'Y' FOR SUB ACCOUNTS"; AQ 

17 INPUT "ENTER CONSTANT CATALOG NUMBER IF DESIRED" ,-CC 

18 DATA "GERALD W. WAGNER 

19 DATA "1104 ASPEN DRIVE 

20 DATA "TOMS RIVER, NJ 08753 
30 READ A1,A2,A3 
35 RESTORE 
40 INPUT "ENTER 
60 U$="##* % 
70 U4$="### % 
80 Ul$="#t# % 

90 U2$=" % %%%" 

93 U3$=" $»»»».##" 

95 INPUT "ENTER 'L' TO LOAD ORDER FROM TAPE";CD 
97 IF CD="L" GOTO 1500 

99 GOSUB 800 

100 FOR I=J+1TO50 

110 GOSUB 500 : IF Q(I)=0 GOTO 140 
120 GOSUB 550 
130 NEXT I 

135 PRINT "STORAGE CAPACITY EXHAUSTED, NO NEW LINES 
140 N=I-1 : GOSUB 600 
150 IF D="" GOTO 157 ELSE GOTO 153 
153 CD=D : D="" : GOTO 170 
157 GOSUB 700 
160 INPUT CD 
170 IF CD="R' 
180 IF CD="C ! 
190 IF CD="T' 
200 IF CD="P" GOTO 1 
210 IF CD="E" END 
220 IF CD="N 

222 IF CD="S 

223 IF CD="L" GOTO 15 
225 IF CD="A" GOTO 480 

227 IF CD="B" GOTO 1250 

228 IF CD="D" GOTO 1300 

229 IF CD="F" GOTO 430 

230 PRINT "BAD CODE, TRY AGAIN" : GOTO 
250 REM ORDER REVIEW ROUTINE 

255 K=-9 : L=0 

260 K=K+10 : L=L+10 

270 IF K>N GOTO 150 

280 IF L>N LET L=N 

290 CLS : PRINT "QTY CAT NO. ";TAB(25) "DESCRIPTION";TAB(48) 

300 FOR I=KTOL 

310 GOSUB 550 

320 NEXT 

340 INPUT "HIT ENTER TO CONTINUB";D 






GOTO 250 
GOTO 360 
GOTO 450 



GOTO 3 
GOTO 1400 
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"COST EA COST TOT" 
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350 GOTO 260 

360 REM LINE CHANGE ROUTINE 

362 GOSUB 370 : GOSUB 500 

364 PRINT "THIS IS CHANGED LINE" 

366 GOSUB 550 : GOTO 450 : 

370 REM LINE CHANGE SUBRT 

380 INPUT "ENTER CATALOG NUMBER TO BE CHANGED/DELETED" ;CT 

390 FOR I=1T0N 

400 IF CN(I)=CT GOTO 420 

410 NEXT : PRINT "CATALOG NUMBER NOT FOUND ON ORDER" : GOTO 150 

420 PRINT "THIS IS OLD LINE" 

422 GOSUB 550 

425 RETURN 

430 REM FREE SPACE ROUTINE 

433 PRINT "FREE STRING SPACE IS";FRE(A) 

436 PRINT "THIS IS ";FRE(A)/2000*100; "% OF RESERVED SPACE" 

438 GOTO 150 

450 REM TOTALS REVIEW 

460 GOSUB 600 

470 GOTO 150 

480 REM ADD TO ORDER ROUTINE 

490 J=N :'GOTO 100 

500 REM SUBRT TO ACCEPT A LINE OF DATA OR FIX A LINE 

510 INPUT "ENTER QUANTITY" ;Q( I) 

515 IF Q(I)=0 RETURN 

520 INPUT "ENTER CATALOG NUMBER" ;CN( I) 

525 IF CDO"C" CN(I)=CC+CN(I) 

527 IF RIGBT$(CN(I),4)="NCCN" INPUT "ENTER CAT. #, NO CC NO";CN(I) 

530 INPUT "ENTER DESCRIPTION" ;DS(I) 

540 INPUT "ENTER UNIT PRICE" ;UP(I) 

541 IF AQO"Y" GOTO 545 

542 INPUT "ENTER 2 CHAR SUB ACNT";AC(I) 
545 RETURN 

550 REM LINE PRINT SUBRT 

560 IF AQO"Y" PRINT USING U$;Q(I) ,CN(I) ,DS(I) ,UP(I) ,Q(I) *UP(I) 

570 IF AQ="Y" PRINT USING U4S;Q( I) ,CN( I) ,DS(I) , AC { I) ,UP(I) ,Q(I) *UP(I) 

590 RETURN 

600 REM END OF ORDER SUBRT 

601 ST=0 : NA=1 : AN(1)=AC(1) : J=0 : S(1)=0 

602 FOR I=1T0N : IF AQO"Y" GOTO 610 

603 FOR I3=1T0NA 

604 IF AC(I)=AN(I3) GOTO 605 ELSE 607 

605 S(I3)=S(I3)+Q(I)*UP{I) 

606 GOTO 610 

607 NEXT 13 : NA=NA+1 

608 S(NA)=Q(I)*UP(I) 

609 AN(NA)=AC(I) 

610 ST=ST+Q{I)*UP(I) 

611 NEXT I 
618 PRINT 

620 PRINT "TOTAL NUMBER OF LINE ITEMS"! N 

640 P=INT(ST)+2-ST 'EVEN $ ROUNDUP 

645 T=ST+P 

650 PRINT "SUBTOTAL"; USING U35.-ST 

660 PRINT "POSTAGE "; USING U3$;P 

670 PRINT "TOTAL "; USING U3$,-T 

672 IF AQO"Y" GOTO 690 

673 PRINT "SUB ACNT TOTALS" 
675 FOR I=1T0NA 

677 S(I)=S(I)+S(I)/ST*P 

680 PRINT AN(I); TAB(8) USING U3$;S(I) 

685 NEXT 

686 IF CD="P" GOTO 690 

687 INPUT "HIT ENTER TO CONTINUE";D 
690 RETURN 

700 REM MENU SUBRT 

705 PRINT TAB(25) "MENU" 

710 PRINT "ENTER 'R' TO REVIEW ORDER, 'T' TO REVIEW TOTALS 

720 PRINT "ENTGR • C TO CHANGE, 'D' TO DELETE ANY LINE 

730 PRINT "ENTER 'S' TO SAVE, 'L' TO LOAD ORDER TO/FROM TAPE 

740 PRINT "ENTER 'P' TO PRINT THE ORDER 

750 PRINT "ENTER 'E' TO END THE PROGRAM, 'N' TO START NEW ORDER 

760 PRINT "ENTER 'A' TO ADD TO ORDER, 'B' TO CHANGE ADDRESSEE 

770 PRINT "ENTER 'F' FOR FREE STRING SPACE" 

7 80 RETURN 

800 REM SUBRT TO ENTER COMPANY 

810 PRINT 

820 INPUT "ENTER COMPANY NAME"; CI 

830 INPUT "ENTER COMMPANY ADDRESS", -C2 

840 INPUT "ENTER COMPANY LOCATION AND ZIP(NO COMMAS) ";C3 

845 PRINT : RETURN 

850 REM ADDRESSEE PRINT SUBRT 

860 PRINT TAB (20) CI 

870 PRINT TAB(20) C2 

880 PRINT TAB(20) C3 

890 RETURN 

1000 REM ORDER PRINT ROUTINE 
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1002 GOSUB 600 

1003 PRINT 

1005 INPUT "READY PRINTER, HIT ENTER";D 

1010 LPRINT TAB(10) "COMPUTERIZED ORDER 

1013 GOSUB 1015 : GOSUB 1060 : GOTO 1100 

1015 REM ADDRESSEE LABEL PRINT SUBRT 

1020 LPRINT : LPRINT "TO:" 

1030 LPRINT TAB(10) CI 

1040 LPRINT TAB(10) C2 

1050 LPRINT TAB(10) C3 

1055 RETURN 

1060 REM ORDERER LABEL -PRINT SUBRT 

1065 LPRINT : LPRINT TAB(5) "FROM:" 

1070 LPRINT TAB (15) Al 

1080 LPRINT TABU5) A2 

1090 LPRINT TAB(15) A3 

1095 RETURN 

1100 REM ORDER PRINT ROUTINE CONTINUED 

1110 LPRINT 

1113 IF AS="NS" LPRINT "NO SUBSTITUTIONS PLEASE" 

1116 LPRINT 

1120 LPRINT "QTY CATALOG NUMBER UN COST TOT COST 

1130 LPRINT " DESCRIPTION 

1140 LPRINT STRINGS (3 9,"-") 

1150 FOR I=1T0N 

1160 LPRINT USING U1$;Q(I) ,CN(I) ,UP(I) ,UP(I) *Q(I) 

1170 LPRINT USING U2S;DS(I) ,AC (I) 

1190 LPRINT STRINGS(39,"-") 

1200 LPRINT TAB(22) "SUBTOTAL"; USING U3S;ST 

1210 LPRINT TAB(22) "POSTAGE "; USING U3$;P 

1220 LPRINT TAB(22) "TOTAL "; USING U3SiT 

1221 IF AQO"Y" GOTO 1228 

1222 LPRINT "SUB ACNT TOTALS" 

1223 FOR I=1T0NA 

1224 LPRINT AN(I);" " USING U3S; S(I) 
1226 NEXT 

1228 LPRINT : LPRINT 

1229 LPRINT TAB(18) "CUT" : LPRINT STRINGS (39, "-") 

1230 LPRINT : LPRINT "SHIPPING LABEL" : LPRINT TAB(5) "TO: 

1232 GOSUB 1070 

1233 LPRINT : LPRINT STRINGS (39,"-") 

1234 GOSUB 1015 

1236 FOR I1=1T08 : LPRINT : NEXT 

123 8 PRINT 

1240 GOTO 150 

1250 REM ADDRESSEE REVIEW AND CHANGE 

1260 GOSUB 850 : GOSUB 800 : GOTO 150 

1300 REM LINE DELETE ROUTINE 

1310 GOSUB 370 : M=I : N=N-1 

1320 FOR I=MTON 

1330 Q(I)=Q(I+1) 

1340 CN(I)=CN(I+1) 

1350 DS(I)=DS(I+1) 

1360 UP(I)=UP(I+1) 

1365 AC(I)=AC(I+1) 

1370 NEXT : GOTO 150 

1400 REM ROUTINE TO SAVE ORDER TO TAPE 

1401 PRINT 
1403 OUT 255,4 

1405 INPUT "READY CASSETTE TO SAVE ORDER, PRESS RECORD, PRESS ENTER" ;D 

1407 FOR I=1TO3000 : NEXT 

1410 PRINT#-1,C1,C2,C3,N 

1420 FOR I=1T0N 

1430 PRINT#-1,Q(I) ,CN(I) ,DS(I) ,UP(I) ,AC(I) 

1440 NEXT : GOTO 150 

1500 REM LOAD ORDER FROM TAPE ROUTINE 

1505 PRINT 

1507 OUT 255,4 

1510 INPUT "READY TAPE, PRESS ENTER" ;D 

1512 OUT 255,0 

1515 INPUT "PRESS PLAY, PRESS ENTER" ;D 

1520 INPUT#-1,C1,C2,C3,N 

1530 FOR I=1T0N 

1540 INPUTS-1,Q(I) ,CN(I) ,DS(I) ,UP(I) ,AC(I) 

1550 NEXT 

1560 GOTO 150 
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MAIL LIST: by Chuck Ross 



Keep your information flow- 
ing in this handy program. Your 
TRS-80 will become an elec- 
tronic secretary, offering you 
twelve program options. Choose 
from such routines as search, lists 
by city, state, name, zip code, 
etc. Does everything but pay the 
postage. 



VH f* [It HW 

r -U wife UIIH « 




10 CLEAR 1000iCLS:DIM Nl$(101) ,N2$ (101) ,A$ (181) ,C1S (101) ,C2$ (101) ,C3$(101) ,PHS(1 

01),O$(101) 
20 CLS:PRINT8 25, "MAILING LIST" 
30 PRINT"1 
40 PRINT "2 
50 PRINT"3 
60 PRINT"! 
70 PRINT"5 
80 PRINT"6 
90 PRINT "7 
100 PRINT " 
110 PRINT "9 
120 PRINT"10 
130 PRINT'll 
140 PRINTU2 



ENTER NAMES INTO LIST" 
SEARCH FOR ONE NAME" 

LIST ALL NAMES IN ONE CITY " 

LIST ALL NAMES WITH THE SAME OPTION LINE" 

LIST ALL NAMES WITH THE SAME CITY AND OPTION " 

LIST ALL NAMES WITH THE SAME ZIP CODE" 
LIST ALL NAMES IN LIST " 
ADD NEW NAMES TO THE LIST" 
MAKE CORRECTIONS" 
SAVE CURRENT FILE ON TAPE" 
INPUT A FILE FROM TAPE " 

TOTAL NUMBER OF NAMES. ON LIST" 

150 INPUT A:CLS: ON A GOTO 160,270,460,650,800,970,1130,1330,1470,1690,1760,1830 

160 PRINT'ENTER ** FOR NAME AFTER LAST DATA ENTRY" 

170 FOR R=l TO 100 

180 PRINT"*";R 

190 INPUT"ENTER LAST NAME";N1?(R) 

200 IF N1$(R)="**" GOTO 30 

210 INPUT"ENTER FIRST NAME AND MIDDLE INITIAL" ;N2S (R) 

220 INPUT"STREET ADDRESS" , -AS (R) 

230 INPUT"ENTER CITY, STATE, ZIP CODE(EXP. TUCSON, AZ , 85730 )" ;C1S (R) ,C2$ (R) ,C3$ 

(R) 
240 INPUT"PHONE #";PH$(R) 
250 INPUT'OPTION CODE"; OS (R) 
260 NEXT R 

270 INPUT'DO YOU WANT THE RESULTS PRINTED ON VIDEO DISPLAY OR PRINTER" ;Q$ :CLS 
280 PRINTe30,"NAME TO BE SEARCHED" 
290 PRINT@128,"LAST NAME"; 
300 INPUT Nl? 

310 PRINT 6168, "FIRST NAME"; 
320 INPUT N2$ 
330 PRINT 

340 FOR R=l TO 100:IF (N1$=N1$(R)) AND(LEFT$ (N2$,4) =LEFT? (N2S (R) , 4) ) THEN 380 
350 NEXT R 

360 PRINT'NAME NOT FOUND IN LIST" 
370 GOTO 30 

380 PRINT N2$(R);" ";N1$(R) 
385 IF LEFTS (Q$,1)="P" GOSUB1920 :GOTO440 
390 PRINT AS(R) :PRINTC1S (R) ; " ";C2S(R);" ";C3S(R) 
400 INPUT "DO YOU WANT THE PHONE #(YES OR NO)";Zl$ 
410 IF Z1$="YES" THEN PRINT PH$(R) 
420 INPUT"DO YOU WANT THE OPTION CODE";Z2$ 
430 IF Z2S="YES" THEN PRINT 0$(R) 

440 INPUT"PRESS ENTER KEY TO RETURN TO COMMAND LIST";Z3$ 
450 GOTO 30 

460 INPUT"DO YOU WANT THE LIST WITH OPTION CODE(YES OR NO)";Zl? 
470 INPUT'DO YOU WANT THE LIST ON VIDEO OR PRINTER" ;QS 
480 INPUT"WHAT IS THE CITY NAME";C1S 
490 PRINT 

500 FOR R=l TO 100 
510 IF C1S=C1$(R) THEN 540 
520 IF N1S(R)="**" THEN 620 
530 GOTO 610 
540 PRINT:IF LEFTS(QS,1) ="P" THEN GOSUB1920:GOTO610 
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550 PRINT N2S(R);" ";NlS(R) 

560 PRINT A$(R) 

570 PRINT C1S(R),-" ";C2S(R);" ■;C3$(R) 

580 IF.Z1S="YES" THEN PRINT 0$ (R) 

590 PRINT 

600 PRINT 

610 NEXT R 

620 PRINT 

630 INPUT-PRESS ENTER KBIT TO RETURN TO COMMAND LIST";Z3S 

640 GOTO 30 

650 INPUT "WHAT IS THE KEYWORD (OPTION CODE)";K$ 

660 INPUT-DO YOU WANT THE LIST ON VIDEO OR PRINTER-.-OS 

670 FOR R = 1 TO 100 

6 80 IP 0$(R)=K$ THEN 710 
690 IF N1S(R)="**" THEN 780 
700 GOTO760 

710 PRINT:IF LEFTS (Q.$,1)="P" THEN GOSUB1920 :GOTO760 

720 PRINT N2$(R);- ";N1$(R) 

730 PRINT A?(R) 

740 PRINT CIS;" ";C2$;" ";C3$(R) 

750 PRINT:PRINT 

760 NEXT R 

770 PRINT 

7 80 INPUT-PRESS ENTER KEY TO RETURN TO COMMAND LIST";Z3S 
7 90 GOTO 30 

800 INPUT-ENTER CITY NAME";C1$ 

810 INPUT-ENTER KEYWORD (OPT ION CODB)";K$ 

820 INPUT-DO YOU WANT THE LIST ON VIDEO OR PRINTER", -OS 

830 PRINT 

840 FOR R=l TO 100 

850 IF N1$(R)="**" THEN 940 

860 IF KS=0$(R) THEN 880 

870 GOTO 93 

880 IF CISOCIS(R) THEN 930 

890 PRINTrIF LEFTS <QS,1) ="P" THEN GOSUB1920:GOTO930 

900 PRINT N2S(R),-" ";N1$(R) 

910 PRINT AS(R) 

920 PRINT C1S(R);" ";C2S(R);" -;C3S(R) 

930 NEXT R 

940 PRINT:PRINT 

950 INPUT-PRESS ENTER KEY TO RETURN TO COMMAND LIST";Z3S 

960 GOTO 30 

970 INPUT-ENTER THE ZIP C0DE";C3S 

980 INPUT "DO YOU WANT LIST ON VIDEO OR PRINTER-.-QS 

990 PRINT 

1000 FOR R=l TO 100 

1010 IF C3S=C3S(R) THEN 1040 

1020 IF N1S(R)="**- THEN 1100 

1030 GOTO1090 

1040 PRINT: IF LEFT? (Q$,l> ="P" THEN GOSUB 1920:GOTO 1090 

1050 PRINT N2S(R);" ";N1$(R) 

1060 PRINT AS(R) 

1070 PRINT CIS(R);" ";C2S(R);" ";C3S(R) 

1080 PRINT: PRINT 

1090 NEXT R 

1100 PRINT 

1110 INPUT"PRESS ENTER KEY TO RETURN TO COMMAND LIST";Z3$ 

1120 GOTO 30 

1130 INPUT-WANT LIST WITH OPTION CODE(YES OR N0)";Z1S 

1140 INPUT-WANT LIST WITH PHONE t";Z2$ 

1150 INPUT "DO YOU WANT THE LIST ON VIDEO OR PRINTER" :0S 

1160 FOR R= 1 TO 5 

1170 PRINT 

1180 NEXT R 

1190 FOR R= 1 TO 100 

1200 IF N1$(R)="**" THEN 1290 

1210 IF LEFT$(QS,1)="P" THEN GOSUB 1920:GOTO 1280 

1220 PRINT N2S(R);" "jNIS(R) 

1230 PRINT A$(R) 

1240 PRINT C1S(R);" ",C2S(R);" "|C3S(R> 

1250 IF Z1S="YES" THEN PRINT OS(R) 

1260 IF Z2$="YES" THEN PRINT PHS(R) 

1270 PRINT:PRINT:PRINT 

1280 NEXT R 

1290 FOR R=l TO 5 

1300 PRINT 

1310 NEXT R 

1320 GOTO 30 

1330 INPUT-HOW MANY NAMES ARE IN THE LIST";A 

1340 PRINT-TYPE ** AFTER THE LAST DATA ENTRY" 

1350 PRINT 

1360 FOR R=(A+1) TO 100 

1370 PRINT"#";R 

1380 INPDT"ENTER LAST NAME";N1S(R) 

1390 IF NIS(R)*"**" THEN 30 

1400 INPUT'ENTER FIRST NAME AND MIDDLE INITIAL";N2S (R) 

1410 INPUT"ADDRBSS"|AS(R) 
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1420 INPUT-CITY, STATE, ZIP CODE" ;C1S(R) ,C2S(R) ,C3$(R) 

1430 INPUT-OPTION CODE"jO$(R) 

1448 INPUT-PHONE «">PH$(R) 

1450 NEXT R 

146B GOTO 30 

1470 INPUT-LAST NAME";N1S 

1480 INPUT "FIRST NAME AND MIDDLE INITIAL" (N2$ 

1490 FOR R=l TO 100 

1500 IF N1S(R)="""THEN 1670 

1510 IF (N1$=N1$(R)) AND (LEPT$(N2$,4) -LEFTS (N2S(R) ,4) ) THEN 1560 

1520 NEXT R 

1530 PRINT "SORRY NAME NOT FOUND IN LIST" 

1540 PRINT 

1550 GOTO30 

1560 INPUT-NEW LAST NAME"|N1S(R) 

1570 INPUT-NEW FIRST NAME AND MIDDLE INITIAL" ;N2$ 

1580 INPUT-ADDRESS"; AS 

1600 INPUT"CITY, STATE, ZIP C0DE-;C1S,C2S,C3S 

1610 C1S(R)=C1S:C2S(R)=C2$:C3S(R)=C3$ 

1620 INPUT-OPTION CODE", -OS 

1630 OS(R)=OS 

1640 INPUT "PHONE #"jPHS 

1650 PHS(R)=PHS 

1660 PRINT-O. K." 

1670 PRINT 

1680 GOTO30 

1690 INPUT'S OF NAMES IN LIST";YY ™__„. „ 

1700 INPUT-MAKE PREPARATIONS FOR CASSETTE, WHEN READY HIT ENTER" iKK 

1710 PRINT "SAVING LIST " 

1730 PR?NTI-i!°r!n1S(R) ,N2S(R) ,A$(R) ,C1S(R) ,C2S(R) ,C3$(R) ,OS(R) ,PHS(R) 

17 40 NEXT R 

1750 CLS- PRINT-LIST SAVED":GOTO30 

1760 INPUT-SET CASSETTE TO PLAY. WHEN READY TO LOAD LIST HIT ENTER ;KK 

1770 INPUT-ENTER THE # OF NAME IN THE LIST";YY 

17 80 PRINT-LIST LOADING " 

1800 ?NPUTi-lf°Ry Y N15(R)-N2S(R),AS(R),ClS(R),C2$(R),C3S(R),OS(R),PHS(R) 

1810 NEXT R 

1820 CLS:PRINT"LIST LOADED" :GOTO30 

1830 PRINT 

1840 R=0 

1850 FOR E=l TO 100 

1860 IF N1$(E)="**" THEN 1890 

1870 R=R+1 

1880 NEXT E 

1890 PRINT-THERE ARE "iR;" NAMES IN THE LIST" 

1900 GOTO30 

1910 END 

1920 LPRINT" " 

1930 LPRINT N2$(R)i" ";N1$(R) 

1940 LPRINT AS(R) 

1950 LPRINTC1$(R);- -;C2S(R))" ";C3$(R) 

1960 IFZ1S="YES" THEN LPRINT 0$(R) 

1970 IF Z25=-YES" THEN LPRINT PHS(R) 

1980 LPRINT" ":RETURN 
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CUSTOM WRITING PROGRAM: by J.N. Adams 



Make this program the foun- 
dation of your electronic word- 
processing system. Over ten pro- 
cessing formats are possible, in- 
cluding text editing, storage and 
hardcopy output. 



CDSICH IWTItt PSCCRf*! 



,L«MEI€Wt£TTES 
JUSTIFY CRI6HT HUM) 

..ixi mmst comas 
\m«i >m copy" 

((MM IfTTB FROH DISK 
• F;1LE LETTER « DISK 
<flH.TER TCXT 
<K>1LL LETTEK FILE 
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18 REM - LETTER WHITING PROGRAM - 

40 CLEAR(4500) :DEFINTH-0,P,S,Y,Z,E:DIMBB$ (56) :DIMC5(11) 

50 F0RI=1T011:READCS(I) :NEXTI 

60 DATAC,J,S,P,R,P,A,K,E,I,T 

70 TA=10 

80 CLS:PRINT§18, "CUSTOM WRITING PROGRAM" 

90 PRINT6128,"<C>REATE NEW LETTER" :PRINT"<J>USTIFY (RIGHT MARGIN) ": PRINT" <S>ET P 

RINTER CONTROLS": 
PRINT"<P>RINT HARD COPY" 
100 PRINT"<R>EAD LETTER FROM DISK" :PRINT"<F>ILE LETTER ON DISK": PRINT"<A>LTE 

R TEXT" ■ 
PRINT"<K>ILL LETTER FILE* 
110 PRINT"<E>XIT PROGRAM":PRINT"<I>NCREASE LENGTH OF LETTER" :PRINT"<T>YPE OPT ON 

SCREEN" 
120 PRINT"" :PRINT"SELECT YOUR OPTION"; 
130 GOSUB1280:I=1 

140 IFCS(I)=ASTHEN150:ELSEI=I+1:IFK12THEN140ELSE130 
150 ONIGOSUB3 80, 550, 290, 1180, 870, 7 40, 440, 180, 27 0,1310, 1140 
160 GOTO80 

17 REM - KILL SUBROUTINE - 

180 CLS:PRINT@18,"KILL LETTER FILE" :PRINT"" 
190 PRINT"WHAT IS THE NAME OF THE FILE?" ; :0=8: 1=0 
200 GOSUB1040:NA$=B$(I)+"/TXT":PRINT"":PRINT"THE FILE NAME IS ";NAS:P8INT"":PRIN 

T"IS THIS THE CORRECT FILE (Y/N)?"; 
210 GOSUB1280:IFA$="Y"THEN250:ELSEIFA$="N"THEN190:ELSEIFA$="E"THENRETURN:ELSE210 
220 PRINT* ":PRINT"WHICH DRIVE IS IT ON (0 - 3) ?" ; : GOSUB1280 
230 IFVAL(A$)<0ORVALA$>3THEN220ELSENA$=NA$+":"+A$ 
240 PRINT:PRINT"TO KILL THIS FILE PRESS ENTER (E TO EXIT) • ; :GOSUB1280 : IFA$="E"TH 

ENRETURNELSECLS:PRINT6276,"** KILLING FILE «*" 
250 KILLNA$:RETURN 
260 REM - EXIT - 

270 CLS:PRINT@276,"** RETURNING TO TRSDOS **":CMD"S* 
280 REM - SET SUBROUTINE - 
290 CLS: PRINT "CONTROLS NOW ARE: " :PRINT°" :PRINT"LINES PER PAGE ";PP:PRINT" 

CHARACTERS PER LINE. . . ";00: PRINT"TAB POSITION ";TA:PRINT"" :PRINT"H 

OW MANY LINES PER PAGE?" ; :0=2: 1=0 
300 GOSUB1040:IFB$(0)=""THEN320ELSEIFVAL(B$(0))>66ORVAL(B$(0))<6THENPRINT"?":GOT 

0300 
310 PP=VAL(B$(0)) :GOSUB360 

320 PRINT"" :PRINT"HOW MANY CHARACTERS PER LINE?";:0=3 
330 GOSUB1040:IFB$(0)=""THEN340ELSEIFVAL(B$(0))>128ORVAL(B$(0))<1THENPRINT"?": 

GOTO330:ELSEOO=VAL(BS(0)) 
340 RETURN 

350 REM - TOP OF PAGE - 
360 TP=INT( (PP-NNJ/2) :RETURN 
37 REM - CREATE SUBROUTINE - 

380 FL=1:II=0:GOSUB290:CLS:PRINT"ENTER LETTER: " :0=00: 1=0 
390 11=11+1 :PRINTUSING"##. "; II ;: F0RR=1T000: PRINT"-" ;: NEXTR:GOSUB1300 : P=P-00-l : P 

RINT@P,"";:GOSUB1040:BB$(II)=B$(I) :NN=II :GOSUB360 
400 IFII>55THENFL=0:RETURN 

410 IFBB$(II)="END"THENII=II-1:NN=II:FL=0:GOSUB360:RETURN 
420 GOTO390 

430 REM - ALTER SUBROUTINE - 
440 IFNN<1THENRETURN 
450 CLS:PRINT"WHICH LINE DO YOU WANT TO CHANGE? (1 TO ";NN; ") ";:0=2: I=0:GOSUB104 
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460 IFB$(I)="E"TBEN RETURN 

470 NU=VAL(BS(I)) : IFNU<1ORNU>NNTHEN450 

480 PRINTLINE ";NU;" READS: ":PRINTBB$(NU) :PRINT:PRINT"IS THIS THE CORRECT LINE? 

(Y/N)";:GOSUB1280:IFA$="N"THEN450 
490 PRINT"" :PRINT"DO YOU WANT TO RETYPE THIS LINE? (Y/N) "; :GOSUB1280: IFAS="Y"THE 

N 500:ELSEIFA$="N"THEN450:ELSE480 
500 PRINT:PRINTBB$(NU):PRINT"ENTER NEW LINE ";NU:O=OO:I=0:GOSUB1040:BBS(NU) =BS (0 

) 
510 PRINT" :PRINT"LINE ";NU;" NOW READS: " :PRINTBB$ (NO) :PRINT"" :PRINT"IS THIS COR 

RECT (Y/N)?"; 
520 GOSHB1280: PRINT" " :IFA$="Y"THEN450 
530 GOTO500 

540 REM - JUSTIFY SUBROUTINE - 
550 IFNN<1THENRETURN 
560 CLS:PRINT"DO YOU WANT TO RIGHT JUSTIFY THIS LETTER? (Y/N) ";:GOSUB1280 :PRINT" 

570 IFA?="N"THENRETURN 

580 IFOO<1THENGOSUB290:CLS 

590 F0RII=1T0NN:PRINTUSING"»S».";II;:PRINT" ", -BBS (II) : PRINT" "; : FORI=1TOOO:P 

RINT"-" ; : NEXTI : PRINT 
600 PRINT"DO YOU WISH TO RIGHT JUSTIFY THIS LINE? (Y/N) ";:GOSUB1280:PRINT"" :IFA$ 

="N"THEN710 
610 JU=00-LEN(BB$(ID) :YY=0:IFJU>INT<LEN(BBS(II) ) *.16)THENPRINT"" :PRINT"** SHOR 

T LINE **":GOTO710 
620 IFJU<1THEN680 
630 LN=LEN(BB$(ID) 
640 FORX=LNT01STEP-l 
650 IFMID$(BBS(II),X,1)=CHRS(32)THEN BBS (II) =LEFT$ (BBS (II) ,X) +" "+RIGHT$ (BBS (II) 

, ( ( LN-X) +YY) ) : JU=JU-1 : YY=YY+1 : IFJU<1THEN6 80 
660 NEXTX 

670 IF JUO0THEN630 

680 PRINT'THE LINE NOW READS: " :PRINTUSING"S## . " ; II ;: PRINT" ";BB$(II) 
690 PRINT'TO CONTINUE PRESS >ENTER< ";:GOSUB1280 
700 PRINT"" 
710 NEXTII 
720 RETURN 

730 REM - FILE SUBROUTINE - 
740 IFNN<1THENRETURNELSE:CLS:PRINT"WHAT DO YOU WANT TO CALL THIS LETTER?" ; :0=8: I 

=0:GOSUB1040 
750 NAS=BS (I) +"/TXT": PRINT: PRINT'THE FILE NAME WILL BE ";NAS 
760 PRINT"" :PRINT"IS THIS ALRIGHT? ";: 
770 GOSUB1280:IFAS="N"THEN740ELSEIFAS="E"THENRETURN 
780 PRINT"" :PRINT"ON WHICH DRIVE DO YOU WANT TO FILE (0-3)?";: 
790 GOSUB1280:NA$=NAS+":"+AS 

800 PRINT"" :PRINT"TO WRITE THE FILE PRESS ENTER (TO EXIT PRESS E)";: 
810 GOSUB1280: PRINT"" :IFAS="E"THENRETURN 
820 CLS:PRINT6276,"*» WRITING DISK **" :OPEN"0",l,NAS 
830 PRINT#1,PP;",";NN;",";TP;",";00 
840 F0RX=1T0NN:PRINT#1,BB5(X) :NEXTX 
850 CLOSE: RETURN 
860 REM - READ SUBROUTINE - 

870 CLS:PRINT518,"READ LETTER FROM DISK" : PRINT"" 
880 PRINT"ENTER NAME OF LETTER " ; :0=8: I=0:GOSUB1040 
890 NAS=B$(I)+"/TXT" 

900 PRINT"" :PRINT"ON WHICH DRIVE IS THE FILE (0-3)?";: 
910 GOSUB1280:NAS=NAS+":"+AS 
920 PRINT"" :PRINT"THE FILE NAME IS " ;NA$ : PRINT"" :PRINT"WHEN READY PRESS >ENTER<" 

;:GOSUB1280:PRINT"":PRINT"*» READING DISK **" 
930 IFA$="E"THENRETURN 
940 OPEN"I",1,NA$:INPUT#1,PP,NN,TP,00 
950 FORX=lTONN:INPUT#l,BB$(X) :NEXTX 
960 CLOSE:GOSUB1140:RETURN 
970 REM - SINGLE KEY ENTRY - 
980 A?=" 

990 PRINT6P,CHR$(143) j:L=l 

1000 AS=INKEY$:IFASO""THENPRINT6P, AS;: RETURN 
1010 L=L+1:IFL<16THEN1000 
1020 PRINT6P," ";:FORL=1TO10:NEXT:GOTO990 
1030 REM - MULT KEY ENTRY - 
1040 PRINTCHR$(14);:BS(I)="" 
1050 AS=INKEYS:IFAS=""THEN1050 
1060 IFFL=1THENIFASC(A$)=44THEN1050 
1070 IFA$=CHRS(13)THENPRINTCHRS(15) :RETURN 
1080 IFA$=CHRS(8)THENIFBS(IX>""THENPRINTAS;:BS(I)=LEFTS(B$(I),LEN(BS(I))-1): GO 

TO1050:ELSEGOTO1050 
1090 IFAS=CHRS(24)THENPRINTCHRS(29);STRINGS(P,CHRS(25));CHRS(30);:GOTO1040 
1100 IFASC(AS)<32ORASC(AS)>90THEN1050 
1110 IFLEN(BS(I))=OTHEN1050 
1120 PRINTAS; : BS (I) =BS (I) +AS :GOTO1050 
1130 REM - TYPE SUBROUTINE - 
1140 IFOO<10RNN<lTHENRETURN 
1150 CLS:PRINT"THE LETTER NOW READS:" 
1160 FORII=lTONN:PRINTUSING"SS#."; II;: PRINT" ";BBS(ID :FORX=1TO250:NEXTX:NEXTII : 

PRINT"": PRINT'PRESS ENTER TO CONTINUE: " ;:GOSUB1280:RETURN 
117 REM - PRINT SUBROUTINE - 
1180 IFNN<1THENRETURN 
1190 CLS:PRINT"THE PRESENT TAB SETTING IS ";TA;", IS THIS OK? (Y/N)"; 
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1200 GOSUB1280:IFAS="Y"THEN1230 

1210 PRINT" :PRINT"WHAT IS THE TAB POSITION?" ;: 0=2: 1=0 

1220 GOSDB1040 : IFVAL(B$ (0) ) <0ORVAL(BS (0) ) >64THENPRINT"?" :GOTO1220 :ELSETA=VAL(B? ( 

0)) 
1230 PRINT" :PRINT"PRESS ENTER TO CONTINUE, E TO EXIT"; :G0SUB1 280: PRINT"" :IFA$=" 

E'THEN RETURN 
1240 POKE16424,PP:IFPEEK(14312)>127TBENPRINT"** PRINTER NOT READY **":GOTO1230 
1250 LPRINTSTRINGS(TP,138) 
1260 OP=PP-(TP+NN) 

1270 F0RII=1T0NN:LPRINTTAB(TA)BB$(II) :NEXTII :LPRINTSTRINGS (OP, 138) :RETURN 
1280 GOSUB1300:GOSUB980:RETURN 
1290 REM - LOCATE CURSOR - 

1300 P=(256*PEEK(16417)+PEEK(16416))-15359:RETURN 
1310 IPNN<1THENRETURNELSECLS:PRINT"ENTBR ADDITIONAL LINES:": II=NN:0=00: I=0:GOS 

UB3 90: RETURN 



INVENTORY: by Don Allen 



This program provides a tape 
storage routine useful for inven- 
tory control in a home and busi- 
ness furnishing company. Single 
line, full page or selected line 
printouts are available. Slight 
modification will make this pro- 
gram suitable for any type of 
small business. 
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10 CLSlPRINTTAB(21)"»* INVENTORY **" 

30 PRINT'THIS PROGRAM PROVIDES A TAPE STORAGE INVENTORY ROUTINE WHICH" 

40 PRINT"CAN BE USED FOR HOME OR SMALL BUSINESS FURNISHINGS/EQUIPMENT." 

50 PRINT'SIMPLE REVISIONS IN HEADINGS AND NOMENCLATURE WILL ENABLE ITS" 

60 PRINT'USE FOR OTHER TYPES OF INVENTORIES, ACTIVITY LOGS, OR DIARIES." 

70 PRINT"SUGGESTIONS AND DETAILS FOR CONVERTING THE PROGRAM TO OTHER" 

80 PRINT'USES ARE LISTED WITHIN ACCOMPANYING PROGRAM NOTES .":PRINT 

90 PRINT'THE PROGRAM PERMITS SELECTION OF PRINT-OUT OF: (1) A SINGLE" 

100 PRINTLINE ITEM; (2) A FULL SCREEN 'PAGE 1 ; (3) A SORTED SELECTION OF" 

110 PRINT'LINE ITEMS; OR (4) ALL LINE ITEMS IN DETAILED OR SUMMARY FORM." 

120 PRINT" INSTRUCTIONS FOR SELECTING OPTIONS ARE LISTED IN PROGRAM." 

130 PRINT'PRESS ENTER TO CONTINUE:" 

140 A$=INKEY$lIFAS=""THEN140 

150 CLS:PRINT?192,"TO KEEP MEMORY IF 'BREAK' OCCURS, USE "GOTO 220"." 

160 PRINT: PRINT'ENSURE THAT PRINTER IS ON-LINE WHEN REQUESTING PRINT-OUT. ": PRINT 

: PRINT" PRESS ENTER TO START:" 
170 AS=INKEYS:IFA$=""THEN170 
180 CLS:CLEAR6800:DIMN(3,65),A$(4,65) 
190 E1S=" M##":F1$=" MMI" 

200 T$(l)="LINE":T$(2)="LOC":TS(3)="ID #":T$(4)="$ VAL" :T$ (5) ="ITEM NAME" 
210 T$ (6) ""CONDITION" :T$ (7) ""DETAILS" 
220 CLS:W1=0:Q1=0:X1=0:P1=0:CT$="KIRVSAD" 

230 J=0:PRINT:PRINT"COMMANDS ARE:":PRINT" K FOR KEYBOARD DATA ENTRY" 
240 PRINT" I FOR TAPE DATA INPUT" :PRINT" R TO RECORD TO TAPE" 
250 PRINT" V TO VIEW ALL DATA ": PRINT" S FOR SELECTIVE REVIEW" 
260 PRINT" A FOR SUMMARY PRINT-OUT OF ALL ITEMS" 
270 PRINT" D FOR DETAILED PRINT-OUT OF ALL ITEMS" 
280 PRINT: PRINT"COMMAND?" 
290 CS=INKEYS:IFC$=""THEN290 
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300 CLS:FOR J=l TO LEN(CTS) 

310 IF CS=MIDS(CTS,J,1)THEN 350 

320 NEXTJ 

330 PRINT"WHAT?" 

340 GOTO230 

350 ON J GOTO 360,540,830,640,1220,1400,1400 

360 PRINT"ENTER DATA: " :PRINT 

370 PRINT"LAST ITEM LISTED IS" ; P: INPUT'ENTER NEXT • " ;N (1 ,P) :CLS 

380 PRINT"LOCATIONS ARE CODED AS : " : PRINT'LR = LIVING ROOM DR = DINING ROOM" 

390 PRINT"KI = KITCHEN IB = BEDROOM » 1" 

400 PRINT'BA = BATHROOM 2B = BEDROOM t 2° 

410 PRINT'GA = GARAGE 3B = BEDROOM t 3" 

420 PRINT: INPUT"WHERE LOCATED"; AS (1 ,P) 

430 CLS: INPUT" IDENTIFICATION # ATTACHED TO ITEM (LAST 4 DIGITS) " ;N (2, P) :PRINT 

440 INPUT'DOLLAR VALUE (WHOLE DOLLAR) " ;N(3 ,P) : PRINT 

450 INPUT"ITEM NAME"; AS (2,P) :PRINT 

460 INPUT"CONDITION (EXCEL, GOOD, FAIR, OR POOR) " ; AS (3 ,P) : PRINT 

470 INPUT"DETAILS (INCLUDE DATE ACQUIRED) "; AS (4 ,P) :PRINT 

480 P=P+1 

490 IFP>65PRINT"MEMORY FULL SAVE DATA ON TAPE AND RUN PROGRAM FOR NEW DATA." 

:GOTO230 
500 PRINT"FOR MORE ENTRIES, TYPE "M"; FOR INDEX, TYPE "I"." 
510 A$=INKEY$:IFA$=""THEN510 
520 CLS:IFA$="M"THEN360 
530 GOTO220 

540 PRINT"PUT INVENTORY DATA TAPE IN RECORDER AND PRESS "PLAY";" 
550 PRINT: PRINT"PRESS "ENTER" TO INPUT DATA." 
560 A$=INKEYS:IFA$=""THEN560 

570 PRINT: PRINT"PLEASE STANDBY WHILE I COPY TAPE:":PRINT 
580 INPUTS-1,P 
590 FOR J=0 TO P-l 

600 INPUT*-1,N(1,J),A$(1,J),N(2,J),N(3,J),A?(2,J),A$(3,J),A$(4,J) 
610 NEXTJ 

620 INPUT'TAPE HAS BEEN COPIED PRESS 'ENTER' FOR INDEX:"lA$ 

630 CLS:GOTO220 

640 IFP>0GOTO680 

650 PRINT6192, "NOTHING IN FILE; PRESS ENTER TO CONTINUE." 

660 AS=INKEY$:IFA$=""THEN660 

670 GOTO220 

680 GOSUB 970 

690 FOR J=0TOP-1 

700 GOSUB990:W1=W1+N(3,J) :X1=X1+1:P1=P1+1: IFXK10GOTO800 

710 IF X1=10X1=0:Q1=Q1+W1:PRINT"PAGE VAL.=S";W1;" ;T0T.VAL.=$";Q1; " **":A$="":W1 

=0 
720 PRINT"SELECT: N=NEXTPAGE; P=PRINT; D=DETAILS; C=REVISE; I=INDEX." 
730 AS=INKEYS:IFAS=""THEN730 
740 IFA$="I"THEN220 
750 IFAS="D"INPUT°TYPE AND ENTER ITEM S" ; J : J=J-1:Q1=0 :W1=0 :X1=10 : P1=P:GOSUB970 :G 

OSUB990:GOSUB1010:GOTO710 
760 IFAS="P"GOSUB1630:AS="N" 

770 IFA$="C"INPUT"TYPE AND ENTER ITEM #"; J:T=P:P=J-1:GOTO1020 
780 IFP>P1CLS:GOSUB970:GOTO800 
790 IFA$="N°GOTO220 
800 IFP>P1NEXTJELSEX1=10:GOTO710 
810 X1=10:GOTO720 
820 CLS:GOTO230 
830 IFP>0GOTO850 
840 GOTO650 

850 PRINT"PUT TAPE TO RECEIVE DATA IN RECORDER: SET RECORDER TO RECORD;." 
860 PRINT:PRINT"PRESS 'ENTER' TO START RECORDING. ": PRINT 
870 A5=INKEYS:IFA$=""THEN870 

880 PRINT: PRINT"STANDBY WHILE I RECORD DATA. " :GOTO900 
890 PRINT"STANDBY:":R1=P:P=P-1:FORJ=PTOP:GOTO250 
900 PRINT8-1,P:FORJ=0TOP-1 

910 PRINTS-1,N(1,J),A$(1,J) ,N(2,J) ,N (3 , J) , A? (2, J) , AS (3 , J) , AS (4, J) 
920 NEXTJ 

930 IFR1O0THENP=R1 

940 PRINT"RECORDING IS COMPLETE; PRESS ENTER TO CONTINUE." 
950 AS=INKEYS:IFAS=""THEN950 
960 CLS:GOTO220 
970 CLS:PRINTTS(1);TAB(6)TS(2) ;TAB(12)TS (3) ;TAB(19)TS (4) ;TAB(26) TS (5) ;TAB(54)TS ( 

6) 
980 PRINTSTRINGS(62,"-") :RETURN 

990 PRINTN(1,J);TAB(6)AS(1,J) ;:PRINTUSING E1S;N (2, J) ; : PRINTUSING F1S;N(3,J); 
1000 PRINTTAB(26)AS(2,J);TAB(54)AS(3,J) : RETURN 
1010 W1=N(3,J) :PRINT:PRINT"DETAILS:";AS(4,J) :RETURN 

1020 CLS:PRINT"TO DELETE ALL DATA FOR THIS ENTRY, TYPE "X" FOR NEXT INPUT;" 
1030 PRINT:PRINT"FOR REVISIONS, IF DATA IS CORRECT, JUST PRESS ENTER;" 
1040 PRINT'IF NOT, TYPE AND ENTER REVISED DATA.":PRINT 
1050 PRINT"ITEM t IS ";J 

1060 PRINT"LOCATED IN :"; AS (1 ,P) ;: INPUT" : CHANGE";C1S 
1070 IFC1S="X"THEN1690 
1080 IFC1S<>""AS(1,P)=C1S:C1S="" 

1100 PRINT"ITEM ID # : ";N( 2,P) ; : INPUT" : CHANGE" ;N(2,P) 
1110 PRINT"VALUE IS : " ;N (3 ,P) ; : INPUT" : CHANGE";N(3,P) 
1120 PRINT'ITEM NAME :";AS (2,P) ; : INPUT" : CHANGE";C3$ 
1130 IFC3$<>"A$(2,P)=C3$:C3$="" 
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1150 PRINT-CONDITION IS : ",A$ (3 ,P) ; : INPUT": CHANGE";C4$ 

1160 IFC4$="C4S-AS(3,P) 

1170 A$(3,P)-C4$ 

1180 PRINT-DETAILS: "jAS (4,P) ! : INPUT" : CHANGE";C5$ 

1190 IFC5$<>"AS(4,P)=C5S:C5S="" 

1210 J=P:P=T:GOSUB970:GOSUB990:GOSUB1010:X1=10:Q1=0:P1=P:GOTO710 

1220 IPP>0GOTO1240 

1230 GOTO650 

1240 PRINT-SELECT FOR REVIEW: l=LIV.ROOM 2=DIN.ROOM 3=KITCHEN 4=BATH" 

1250 PRINT"5=BEDROOM »1 6=BEDR00M #2 7=BEDROOM «3 8=GARAGE 9=ITEH #." 

1260 INPUT-TYPE AND ENTER *:"jZ 

1270 IFZ<1ORZ>9PRINT"REDO":GOTO1240 

1280 IFZ=9AS="D-:GOTO750 

1290 GOSUB970 

1300 ONZGOTO1310, 1320, 1330, 1340, 1350, 1360, 1370, 1380 

1310 FORJ=0TOP-1:IFAS(1,J)="LR"GOSUB990:GOSUB1500 

1315 NEXT:X1=10:GOTO1520 

1320 FORJ=0TOP-1:IFA$(1,J)="DR"GOSUB990:GOSUB1500 

1325 NEXT:X1=10:GOTO1520 

1330 FORJ=0TOP-1:IFA?(1,J)="KI"GOSUB990:GOSUB1500 

1335 NEXT:X1=.10:GOTO1520 

1340 FORJ=0TOP-1:IFA$(1,J)="BA"GOSUB990:GOSUB1500 

1345 NEXT:X1=10:GOTO1520 

1350 FORJ-=0TOP-1:IFA$(1,J)="1B"GOSUB990:GOSUB1500 

1355 NEXT:X1=10:GOTO1520 

1360 FORJ=0TOP-1:IFA$(1,J)="2B"GOSUB990:GOSUB1500 

1365 NEXT:X1=10:GOTO1520 

1370 FORJ=0TOP-1:IFA$(1,J)="3B"GOSUB990:GOSUB1500 

1375 NEXT:X1=10:GOTO1520 

1380 FORJ=0TOP-1:IFA$(1,J)="GA"GOSUB990:GOSUB1500 

1385 NBXT:X1=10:GOTO1520 

1390 GOTO220 

1400 IFP>0THEN1420 

1410 GOTO650 

1420 CLS:PRINT6520, "PRINTING PLEASE WAIT:" 

1430 LPRINTT$(1);TAB<6>T$<2);TABU2)T$(3);TAB(19)T$(4);TAB(26)T$(5);TAB(54)T$(6) 

1440 LPRINTSTRING$(62,"-") 

1450 FORJ=0TOP-1 

1460 LPRINTN(1,J);TAB(6)AS(1,J) ,-:LPRINTUSING E1$:N(2, J) ; :LPRINTUSING F1$;N(3,J): 

1470 LPRINTTAB(26)A$(2,J);TAB(54>A$(3,J):W1=W1+N(3,J) 

1480 IFC$="D"LPRINTT$ (7 ) ; " : " ;AS (4 , J) :LPRINT 

1490 NEXT:LPRINT:LPRINT"TOTAL VALUE = S" ;W1:GOTO220 

1500 W1=W1+N(3,J) :X1=X1+1:IFJ=P-1X1=10:GOTO1520 

1510 IFXK10RETURN 

1520 IFX1=10X1=0:Q1=Q1+W1:PRINT"PAGE VAL.=S" [Wl ,- " ;TOT.VAL. =S" ;Q1 ; " **":W1=0 

1530 PRINT'SELECT: N=NEXT PAGE; P=PRINT; D=DETAILS; C=REVISE; I=INDEX." 

1540 A$=INKEY$:IFA$=""THEN1540 

1550 IFA$="I"THEN220 

1560 IFA$="P"GOSUB1630:AS="N" 

1570 IFA$="D"INPUT"TYPB AND ENTER ITEM #" ; J: J=J-1 :Q1=0 :X1=10 :GOSUB970 :GOSUB990 :G 

OSUB1010 : J=P-1 :GOTO1520 
1580 IFA$="C"INPUT"TYPE AND ENTER ITEM # " ; J :T=P: P=J-l:GOTO1020 
1590 IFP-1>JCLS:GOSUB970:GOTO1610 
1600 IFA$="N"GOTO220 

1610 IFP-1>JTHENRETURNELSEX1=10:GOTO152B 
1620 GOTO220 

1630 Z1=896:S1=15360:E1=16383:PRINT@Z1, "PATIENCE PLEASE" 
1640 F0RA1=S1T0E1:B1=PEEK(A1) 
1650 IFB1=42N1=0:LPRINTCHR$(13) :RETURN 
1660 LPRINTCHR$(B1);:N1=N1+1 
1670 IFNl=64Zl=Zl+2:PRINTe896,STRING?(50," ") :PRINT6Z1, "PATIENCE PLEASE" ; :LPRINT 

CHR$(13):N1=0 
1680 NEXTA1: RETURN 

1690 CLS:J=J-1:F0RX=JT0T:A$(1,X)=A$U,X+1):A$(2,X)=A?(2,X+1) 
1700 A$(3,X)=A$(3,X+1):A$(4,X)=A$(4,X+1):N{2,X)=N(2,X+1):N(3,X)=N(3,X+1) 
1710 NEXTX:P=T-1:GOTO220 
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CONTRACTOR: by CJ. Stinson 



This program will be a valu- 
able aid in cost estimation for the 
busy private contractor. Hard 
copy output requires a line 
printer. 
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25 CLS:PRINT"CONTRACTOR COST ESTIMATING" 

30 CLEAR100: INPUT-READY LINE PRINTER - PRESS ENTER";B$ 

35 CLS:IF PEEK(14312)<=127 GOTO50 

40 PRINT6906,"*** LINE PRINTER NOT READY ***"; 

44 FORI=1TO200:NEXT:GOTO35 

50 CLS 

52 E$="$$M,»#*.#*":F$="t#, ***.*♦" 

100 PRINT:D=D+1:INPUT"J0B NAME";A$ 

110 INPUT"NUMBER OF INSTALLATIONS ";Q 

120 GOSnBlB00 

130 GOSUB2500 

150 INPUT"OVERHEAD (% OF DIRECT LABOR) ";C 

155 O=C/100 

160 INPUT"PROFIT {% OF JOB COST)"iZ 

170 P=Z/100 

190 INPUT'PRESS "ENTER" TO DISPLAY RESULTS";B$ 

200 B=Q*M:K=Q*L:J=H*Q:V=(L+H)*0 

310 W=V*Q:R=(B+K+J+W)*P:X=R/Q:S=B+K+J+R+W:T=S/Q 

380 GOSUB3000 

400 INPUT"TO HAKE ANOTHER RUN PRESS 'ENTER' ";B$ 

410 CLS:GOTO50 

1800 REM 

1810 INPUT"DO YOU NEED TO ITEMIZE MATERIAL COSTS <Y/N)";B$ 

1820 IFBS="N"THEN1850 

1822 IFB$O"Y"THEN1810 

1825 LPRINT" " :LPRINT"raATERIAL COST"; 

1830 GOSUB2000:M=C:RETURN 

1850 INPUT"MATERIAL COST PER UNIT";M:RETURN 

2000 CLS:C=0:LPRINTTAB(48> "ESTIMATE # ";D 

2130 LPRINT" ITEM";TAB(20)"COST";TAB<32)"QUANTITY";TAB(52) "EXTENDED" 

2170 PRINT80, "ENTER ITEM, COST, QUANTITY" , " "," "; 

2180 PRINT828,"";: INPUTBS,A,G:E=A*G 

2200 IF A=0 THEN2300 

2210 LPRINTLEFT$(B$,16) ;TAB(16)USINGF$;A; :LPRINTTAB(38)G;TAB(48) USINGFS;E 

2220 C=C+B:GOTO2170 

2300 LPRINTTAB(32)"TOTAL";TAB(46)USINGE$;C:LPRINT" " 

2310 INPUT"PRESS "ENTER" TO CONTINUE COST ESTIMATE";BS 

2320 CLS:RETURN 

2500 REM 

2510 INPUT"DO YOU NEED TO ITEMIZE SHOP LABOR (Y/N)";B$ 

2520 IFBS="N"THEN2570 

2521 IFB$O"Y"THEN2510 

2522 LPRINT" " :LPRINT"SHOP LABOR"; 
2525 GOSUB2000 

2530 L=C:GOTO2600 

2570 INPUT"SHOP LABOR PER UNIT";L 

2600 INPUT"DO YOU NEED TO ITEMIZE ON-SITE LABOR (Y/N)";B$ 

2610 IFB$="N"THEN2670 

2612 IFB$O"Y"THEN2600 

2615 LPRINT" " :LPRINT"ON-SITE LABOR"; 

2620 GOSUB2000 

2630 H=C:RETURN 

2670 INPUT'ON-SITE LABOR PER UNIT";H:RETURN 

3000 LPRINT" " 

3010 LPRINT"JOB NAME";TAB(10)A$;TAB(40) "ESTIMATE ♦ ";D 

3020 LPRINT"ESTIMATE PARAMETERS" , "PER UNIT" , "EXTENDED" 

3030 LPRINT:LPRINT"NUMBER OF INSTALLATIONS"," ",Q 
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304B LPRINT"MATERIAL C0ST";:LPRINTTAB(3B)USINGF$iM; :LPRINTTAB(46)USINGF$;B 
3B5B LPRINT'SHOP LABOR COST";:LPRINTTAB(3B)USINGF$;L; :LPRINTTAB(46> USINGFSjK 
3B6B LPRINT"ON-SITE LABOR COST"; :LPRINTTAB(30)USINGFS;H; :LPRINTTAB(46)USINGFS; J 
3070 LPRINT"OVERHEAD","("|Cj"%) "| :LPRINTTAB(30)USINGF$;V; :LPRINTTAB(46) USINGF$;W 
3B8B LPRINT'PROFIT", "("(Z; "%) "; :LPRINTTAB(30)USINGF$;X; :LPRINTTAB<46) USINGF$;R 
3B9B LPRINT" ":LPRINT"JOB PRICE";:LPRINTTAB(28)USINGE$;T; :LPRINTTAB(44) USINGE$;S 

: LPRINT 
3100 RETURN 



ROUGH LUMBER LIST: by D.| Brickner 



Accurately estimate rough 
lumber requirements for build- 
ing with the Lumber List pro- 
gram. An excellent adjunct to 
the small contractor's or do-it- 
yourselfer's bag of tricks. 
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10 CLEAR 20B:DEFINT G-K:BEFSTR A-E,L-R,Y:IT=12:B="FT" :C="IN" :D="T" 

20 Y="Y":N="N":BL=" ":E{0) =BL:E(1)=BL:Q="???" :A=BL:BT=B:0=" (" :P=") ":BS="/" 

25 SJ=.35:LW=" LENGTHS" :LF="1ST FLR ":LG="2ND PLR " 

30 CLS:PRINTS78, "ROUGH LUMBER LIST PROGRAM REV B.0" 

40 PRINT" ":PRINT"NAME ( ";AfPj : INPUT A 

45 PRINT'NUMBER OF STORIES (";JSiPj: INPUT JS 

50 XY=S1:M= "LENGTH IS" :R="LENGTH " :GOSUB950:S1=XY 

60 XY=S2:M= "WIDTH IS":R="WIDTH " :GOSUB95B:S2=XY 

70 M="BASEMENT ": JT=J4:GOSUB930: J4=JT:IF J4=0 J5=1:GOTO90 

80 M="CONCRETE FLOOR " :JT=J5:GOSUB930: J5=JT:IF J5=0 J6=0:GOTO11B 

90 IF S1=S2 J6=1:GOTO110 

100 M="FLOOR JOISTS RUN LENGTHWISE " :JT=J6 :GOSUB930: J6=JT 

110 M="TRUSS ROOF " : JT=J9 :GOSUB930: J9=JT: IF J9-1 JA=0:GOTO130 

120 M="INCLUDE TRUSS MATERIALS " : JT=JA:GOSUB93B: JA=JT: IF JA=1 J7=B:S8=0:GOTO210 

130 IF SB=0 ST=0:SU=0:GOTO15B 

140 G=ST/IT:I=ST-G*IT+.5:M="ROOF PITCH IS"+STR$(G)+BL+B+STR$ (I) +BL+C+BS 

150 XY=SU:R="ROOF PITCH (RISE/RUN) ":GOSUB950: IF LEN(L)=0 GOT019B 

160 BT=BS:GOSUB900:BT=B:IF J=0 PRINTQ:GOTO150 

170 L=MID$(L,J+1) :GOSUB900:IF J=0 PRINTQ:GOTO150 

180 ST=XY:GOSUB990:SU=XY:S8=ST/SU 

190 IF S1=S2 THEN J7=0:GOTO210 

200 M="RAFTERS RUN LENGTHWISE " : JT=J7 :GOSUB930: J7=JT 

210 LX=LF:X1=SB:X2=SC:X3=SD:GOSUB250:SB=X1:SC=X2:SD=X3:IF JSX2 GOTO290 

220 LX=LG : X1=SE : X2=SF : X3=SG: GOSUB250 : SE=X1 : SF=X2 : SG=X3 : GOTO290 

250 M=LX+»EXT. *MASONRY*"+LW:XX=X1:GOSUB800 :X1=XX 

260 M=LX+"EXT. *FRAME*"+LW:XX=X2:GOSUB800 :X2=XX 

270 M=LX+"*INTERIOR*"+LW:XX=X3:GOSUB800:X3=XX:RETURN 

290 XY=SH:M="EAVE OVERHANG IS":R="EAVE OVERHANG ":GOSUB 950:SH=XY 

300 XY=SI:M="GABLE OVERHANG IS":R="GABLE OVERHANG ":GOSUB 950:SI=XY 

310 M="COST TO BE CALCULATED ": JT=JK:GOSUB930: JK=JT: IF JK=1 SJ=.35 :GOTO380 

320 M="COST FIGURE OF MERIT " 

330 IF SJ=0 GOTO360 

340 PRINT"CURRENT ";M;"IS"; 

350 PRINT USING"$$###.S#";SJ;:PRINT" PER BOARD FOOT" 

360 PRINT M;:L="":INPUT L:IF LEN(L)><0 SJ=VAL(L) 

380 M="REVIEW INPUT" :E (0) =BL:JT=0 :GOSUB930: IF JT=1 GOT0395 

390 E(0)=Y:E(1)=N:GOTO40 
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395 CLS: PRINT-ROUGH LUMBER LIST FOR: ";A:PRINT STRING$(64,"*") ; 

400 A0="2X":B0="4X":C0="2":D0="4":E0="6":O0="8":P0="10":R0="12" 

402 Al="FOUNDATION GRD RWS4S" :Bl="CONSTRUCTION GRADE" 

404 C1="STANDARD OR BETTER" :D1="INT 5/8 PLYSCORD" 

406 El =" CLEAR": 01= "EXT 1/2 PLYSCORD" :P1="1ST FLR " 

408 R1="MUD SILLS " :A2="J0ISTS" :B2="BLK & BOX" 

410 C2="SHEATHING":D2="FIRRING":E2="WALL STUDS" :02="SH0E" 

412 P2="DBL PLATE" :R2="HEADBRS":A3="TRUSS ":B3="CH0RD" 

414 C3="WEB":D3="ATTIC " :E3="CEILING ":03="BEAHS" 

416 P3="R00F ":R3="0VERHANG " :A4="STUD" :B4="2ND FLR " 

418 X1=240:X2=16:X3=.6/SJ:X4=16:X5=.65/SJ:X6=.35/SJ 

420 X7=16:X8=.62/SJ:X9=16:XA=.96/SJ:XB=16:XP=.999:XZ=24 

460 PRINT8128, "PIECES", -TAB (9) "SIZE", -TAB (15) "LENGTH" ;TAB( 24) "DESCRIPTION"; TAB (46) 

"USE" 
465 M=P1:KL=0:SM=SB:SN=SC:SO=SD 

470 PRINTSTRING$(64,"*"),-:WS=1.1:FB=0:IF J5=0 GOTO710 

480 KT=2*WS*(S1+S2)/IT+XP:L0=BL:L1=A0+E0:L2=STRS(KT) :L3=A1:L4=R1:G0SUB 1000 
490 L1=A0+O0:L2=" 6":L4=R1+"0N PIER" :GOSUB1000:FB=FB+(KT+8) *X3+XP 
510 KF=1:IF J6=0 U=S1:V=S2:GOTO530 
520 U=S2:V=S1 

530 IF U/KF>X1 THEN U=U+24 :KF»KF+1 :GOTO530 

540 KT=INT(U/KF/XZ+XP)*2:K=WS*V*KF/X2+XP:L0=STR$(K) :L1=A0+P0 
550 L2=STR$(KT) :L3=B1:L4=M+A2:GOSUB1000:FB=FB+K*KT*1.67+XP 
600 XT=V*(KF+2)+U*2:K=XT/Xl+XP:KT=INT(XT/K/XZ+XP)*2 
610 L0=STRS(K) :L2=STR$(KT) :L4=M+B2:GOSUB1000 

620 FB=FB+K*KT*1.67+XP:K=(WS*Sl*S2/4608)+XP:L0=STR$(K) :L1=B0+O0 
630 L2=BL:L3=D1:L4=M+C2:GOSUB1000:FB=FB+K*20*X5+XP:IF KLO0 GOTO710 
640 K=V/X1+XP:KT=INT(V/K/XZ+XP)*2:K=K*(KF-1) :L0=STR$(K) :L1=B0+O0 
650 L2=STR$(KT) :L3=B1:L4=M+O3:GOSUB1000:FB=FB+K*KT*2.67+XP 
710 L2=A4:L3=C1:IF SH<=0 GOTO740 

720 K=WS*SH*(l/X4+.02083)+XP:L0=STRS(K) :L1=A0+C0:L4=M+D2 
730 GOSUB1000:FB=FB+K*2.67*X6+XP 

740 K=WS»(SN+SO)*(l/X7+.02083)+XP:L0=STR$(K) :L1=A0+D0:L4=M+E2 
750 GOSUB1000:FB=FB+K*5.33*X6+XP 

760 KT=WS*(SM+SN+SO)/IT+XP:L0=BL:L2=STRS(KT) :L3=B1:L4=M+O2:GOSUB1000 
770 FB=FB+KT*.667:L2=STRS(KT*2) :L4=M+P2:GOSUB1000 :FB=FB+KT*2* .667 
7 80 KT=WS*(SM+SN)/XZ+XP:L1=B0+R0:L2=STR$(KT) :L4=M+R2:GOSUB1000 :FB=FB+KTM 
790 IF KL=0 AND JS=2 KL=1:M=B4 :SM=SE: SN=SF :SO=SG:GOTO510 
795 GOTO1200 
800 IF XX=0 GOTO820 

810 F=XX/IT:I=XX~F*IT+.5:PRINT"SUM OF ";H;" IS" ;F;B; I;C 
820 PRINT M;:L="": INPUT L:IF LEN(L)=0 RETURN 
830 IF L="Z" XX=0:GOTO810 
840 GOSUB900:IF J=0 PRINTQ:GOTO820 
850 XX=XX+VAL(L)-IT+VAL(HIDS(L,J+2)) :GOTO820 
900 FOR J=l TO LEN(L)-LEN(BT)+1 
910 IF BT=MID?(L,J,LEN(BT)) RETURN 
920 NEXT J:J=0:RETURN 

930 PRINTM;0;E(JT) ;P; :L="" : INPUT L:IF LEN(L)=0 RETURN 
932 IF L=Y THEN JT=0: RETURN 
935 IF L=N THEN JT=1: RETURN 
940 PRINT Q:GOTO930 
950 IF XY=0 GOTO970 

960 G=XY/IT:I=XY-G*IT+.5:PRINTM;G;B:I;C 
970 L="":PRINTR;: INPUT L:IF LEN(L)=0 RETURN 
980 GOSUB900:IF J=0 PRINTQ:GOTO970 
990 XY=VAL(L)*IT+VAL(MIDS(L,J+2)) :RETURN 

1000 PRINTL0;TAB(9)L1;TAB(16)L2;TAB(24)L3;TAB(45)L4:RETURN 
1200 IF J7=0 U=S1:V=S2:GOTO1220 
1210 U=S2:V=S1 

1220 XH=S8*U/2:XY=(U/2+SH)/COS(ATN(S8) ) :XW=V+2*SI 
1222 IF XH=0 GOT01235 

1225 KT=((XH+6)/XZ+.7 4) :KT=KT*2:K=WS*U/X7+XP:L0=STRS (K) :L1=A0+D0 
1230 L2=STR$ (KT) :L3=B1 : L4=D3+A4 + "S" :GOSUB1000 : FB=FB+K*KT* .667 +XP 

1234 KQ=WS*V/X9+XP 

1235 IF J9=l GOSUB1500:GOTO1250 
1240 IF JA=0 THEN GOSUB1700 

1250 KT=WS*2*XY*XW/4608+XP:L0=STR$(KT):Ll=B0+O0:L2=BL:L3=Ol 

1260 L4=P3+C2:GOSUB1000:FB=FB+KT*16*X8+XP:IF SH=0 GOTO1305 

127 XT=2*SH*KQ:K=XT/X1+XP:KT=INT(WS*XT/K/XZ+XP)*2:L0=STRS(K) :L1=A0+D0 

1280 L2=STR$(KT) : L3=C1:L4=P3+R3+"B0X" :GOSUB1000 : FB=FB+KT*K* .66*X6+XP 

1290 KT=WS*2*SH*V/4608+XP:L0=STR$(KT) :L1=B0+O0 :L2=BL 

1300 L3=O1:L4=R3:GOSUB1000:FB=FB+KT*16*X8+XP 

1305 IF JK=1 GOTO1320 

1310 FB=FB*SJ:PRINT"TOTAL COST IS " ; : PRINTUSING"$S»*#i#» . »#" ;FB 

1320 M="DO YOU WISH TO REPEAT THE PROGRAM " : E (0) =BL :JT=0 

1340 GOSUB930:IF JT=1 THEN END 

1350 E(0)-Y:E(1)=N:GOTO30 

1500 KF=1:IF J7-0 U-S1:V=S2:GOTO1530 

1510 U-S2lV=Sl 

1530 IF U/KF>X1 THEN U-U+24 :KF=KF+1:GOTO1530 

1540 KT=INT(U/KF/XZ+XP)*2:K=INT(WS*V/X9+XP)*KF+XP:L0=STR$(K) 

1550 L1-A0+E0:L2=STRS(KT) :L3=B1:L4=E3+A2:GOSUB1000:FB-=FB+KT*K 

1560 XT=V«(KF+2):K=XT/X1+XP|KT=INT(XT/K/XZ+XP)*2:L0=STRS(K) 

1570 L2=STRS (KT) : L4=E3+B2 :GOSUB1000 : FB=FB+K*KT: KT=INT (XY/XZ+XP) *2 

1580 L0-STR$(2*KQ+4) :L2=STRS(KT) :L4=P3+"RAFTERS" :GOSUB1000: :FB=FB+(2*KQ+4) *KT 
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1590 KT«INT(U/3/XZ+XP)*2:L0=STR$(KQ) :L2=STR$(KT) :L4="C0LLAR "+03 

1600 GOSOB1000:FB«PB+KQ.*KT:XT=V+2*SI:K=XT/336+XP 

1610 KT=INT(XT/K/XZ+XP)*2:L0»STR$(K) :L1=A0+O0:L2=STR$(KT) :L3=E1 

1620 L4="RIDGE "+O3lGOSUB1000:FB=PB+K*KT*1.33*XA+XP:RETURN 

1700 XT=U/2lKF=XT/96+XP:WV=XT/KF 

1710 KT=INT(U/XZ+XP)*2:L0=STR5(KQ) :L1=A0+D0:L2=STR$(KT) :L3=B1 

1720 L4»A3+"LOWER "+B3:GOSUB1000:FB=FB+KQ*KT*.66+XP 

1730 KT=INT(XY/XZ+XP)*2:L0=STR$(KQ*2+4) :L2=STR?(KT) :L4=A3+"UPPER "+B3 

17 40 GOSUB1000 IPB-PB+ (KQ*2+4 ) *KT*1 .33+XP:XT=XH+6 : K=96/XT+XP 

1750 KT=INT(XT*K/XZ+XP)*2:K=KQ/K+XP:L0=STR$(K) :L2=STR$ (KT) 

1760 L4=A3+"KING POST":GOSUB1000:FB=FB+KQ/K*KT».66+XP:JI=1 

1770 IF JI>=KF RETURN 

1780 XT-WV*S8«JI+6:K=96/XT+XP:KT=IHT(XT*K/XZ+XP)*2:K=2*INT(KQ/K+XP) 

1790 L0=STR$(K) :L2=STR$(KT) :L4=A3+"VERT "+C3:GOSUB1000 

1800 FB=FB+K*KT*.66+XP:XT=WV*S8*JI:XT=SQR(XT*XT+WV+WV)+6 

1810 K=96/XT+XP: KT=INT (XT*K/XZ+XP) *2 : K=2*INT (KQ/K+XP) 

1820 L0=STR$(K) :L2=STR$(KT) :L4=A3+"SLANT "+C3:GOSUB1000 

1830 FB=FB+K*KT*.66+XP:JI=JI+1:GOTO1770 



SURVEYOR'S PROGRAM: by William Datson 



Balance any traverse by the 
compass rule method with this 
quick program. If interior angles 
and one bearing are known, plug 
values in and let your TRS-80 
"make the calculations. A time 
saver for the professional sur- 
veyor. 
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4 CLS 

5 PRINTS24, "TRAVERSE BALANCE" : FORX=1TO1000:NEXT 

10 CLS:INPUT"DO YOU WISH INSTRUCTIONS (Y OR N) " ; IN$: IFINS="Y"THENGOSUB10000ELSE2 


15 D=0:M=0:S=0 

20 CLS:INPUT"HOW MANY ANGLES" ;N 
25 INPUT'WHAT DIRECTION (R OR L)";DZ$ 
27 INPUT'WHAT IS THE KNOWN BEARING" ;C$, E,F,G,D$ 

29 INPUT"IS ALL INFORMATION CORRECT (Y OR N)";QS 

30 CLS:IFQ$="N"THEN20ELSE31 

31 F0RX=1T0N 

40 INPUT"INPUT STATION NAME AND D,M,S" ; AS, A,B,C:A$ (X) =A$ : A(X) =A:B (X) =B:C (X) =C: IN 

PUT"LENGTH";L(X) 
50 D=D+A:M=M+B:S=S+C 
60 IFS>60THENGOSUB200 
70 IFH>60THENGOSUB300 

80 NEXTX 

81 INPUT"IS ALL INFORMATION CORRECT { Y OR N )";Q$ 

82 IFQ$="N"THENGOTO22000 
85 CLS 

100 PRINT"THE TOTAL OF THE INTERIOR ANGLES IS" 

110 PRINTD; "DEGREES", -M; "MINUTES"; Si "SECONDS" 

120 CO=180*(N-2) 

130 GOSUB2000 

140 GOTO3000 

200 S=S-60:M=M+1: RETURN 

300 M=M-60:D=D+1: RETURN 

2000 MC=60 



65 



2020 IFD<COTHEN2030ELSE2060 

2030 IFS>0THENS=60-S:MC=59:CO=CO-1 

2040 IFM>0THENM=MC-M:CO=CO-1 

2050 D=CO-D 

2060 IFD=COTHEN207 0ELSE2080 

2070 D=0:GOTO2190 

2080 PRINT"THE CORRECTION IS" 

2090 PRINTD; "DEGREES ";M; "MINUTES ";S; "SECONDS" 

2100 PRINT"THE CORRECTED ANGLES ARE" 

2110 PRINT" ANGLE" , "DEGREES" , "MINUTES" , "SECONDS" 

2120 FORX=lTON 

2130 IFS>0THENC(X)=C(X)+(S/N) 

2140 IFM>0THENB(X)=B(X)+(M/N) 

2150 IFD>0THENA(X)=A(X)+(D/N) 

2160 PRINTAS(X) ,A(X),B(X> ,C(X) 

217 NEXTX 

2180 RETURN 

2190 PRINT"THE CORRECTION IS" 

2191 PRINTD; "DEGREES ";M; "MINUTES ";S; "SECONDS" 

2192 PRINT"THE CORRECTED ANGLES ARE" 

2200 PRINT"ANGLE" , "DEGREES" , "MINUTES" , "SECONDS" 

2210 FORX=lTON 

2220 IFS>0THENC(X)=C(X)-(S/N) 

2230 IFM>0THENB(X>=B(X)-(M/N) 

2240 IFD>0THENA(X)=A(X)-(D/N) 

2250 PRINTAS(X) ,A(X) ,B(X) ,C(X) 

2260 NEXTX 

2270 RETURN 

3000 IFDZ$="L"THEN11000ELSE3010 

3010 INPUT"PRESS ENTER TO CONTINUE" jN$ 

3015 CLS 

3020 CB$=C$+D$:GOSUB20000 

3030 FORX=lTON 

3050 E=E+180 

3060 IFE>=360THENE=E-360 

3080 GOSUB4000 

3090 GOSUB5000 

3100 GOSUB6000 

3110 IFX=NTHENGOTO8000ELSENEXT 

3120 END 

4000 IFG+C(X)>60THEN4010ELSE4020 

4010 G=G+C(X) :G=G-60:F=F+1:GOTO4030 

4020 G=G+C(X) 

4030 IFF+B(X)>60THEN4040ELSE4060 

4040 F=F+B(X) :F=F-60:E=E+1 

4050 E=E+A(X) 

4052 IFE>=360THENE=E-360 

4053 RETURN 

4060 F=F+B(X) :E=E+A(X) 

4061 IFE>=360THENE=E-360 

4062 RETURN 

5000 IFE>=0ANDE<90THENE$="N":F$="E":RETURN 

5010 IFE=90ANDF>0THENES="S":FS="E":RETURN 

5020 IFE=90ANDF=0ANDG=0THENES="N":F$="E":RETURN 

5030 IFE>90ANDE<180THENE$="S":F$="E":RETURN 

5040 IFE=180ANDF>0THENE$="S":FS="W":RETURN 

5050 IFE=180ANDF=0ANDG=0THENES = "S":FS="E":RETURN 

5060 IFE>180ANDE<270THENE$="S":F5="W":RETURN 

5070 IFE=270ANDF>0THENES="N":F$="W":RETURN 

5080 IFE=270ANDF=0ANDG=0THENE$="S":F$="W":RETURN 

5090 IFE>270ANDE<360THENE$="N":F?="W":RETURN 

5100 IFE=360ANDF>0THENE$="N":F?="E":RETURN 

5110 IFE=360ANDF=0ANDG=0THBNE$="N":F$="W":RETURN 

6000 H=E:I=F:J=G:IFE>=0ANDE<=90THENE=E:F=F:GOTO6060 

6010 IFE>90ANDE<180THENGOTO7000 

6020 IFE>=180ANDE<27 0THENGOTO7020 

6030 IFE>=270ANDE<=360THENGOTO7040 

6060 ES(X)=E$:E(X)=E:F(X)=F:G(X)=G:F$(X)=F$ 

6070 E=H:F=I:G=J 

6080 RETURN 

7000 E=180-E:IFF>0THENE=E-1:F=60-F 

7010 GOTO6060 

7020 E=E-180 

7030 GOTO6060 

7040 IFE=360THENE=0:F=F:GOTO6060 

7050 IFE<360ANDF>0THENE=36 0-E:E=E-1:F=60-F:GOTO6060 

8000 FORX=1TON 

8010 BS(X)=A$(X)+AS(X+1) 

8020 IFX<NTHENNEXTELSEB$ (X) =A$ (X)+A$ (1) 

9010 FORX=lTON: PRINT "THE BEARING OF ";B$(X);" IS " ; E$ (X) ; E(X) ; F (X) ;G(X) ; FS (X) : NE 

9040 F0RX=1T0N:Z(X)=E(X) :Y(X)=F(X) :X(X)=G(X) :NEXTX 

9060 FORX=1TON:X(X)=X(X)/60:Y(X)=Y(X)+X(X) :Y(X) =Y (X)/60:Z (X) = Z (X) +Y (X) :Z(X)=Z(X) 

*.0174533:LA(X)=L(X)*COS(Z(X)) :DE(X) =L(X) *SIN(Z (X) ) : NEXT 
9150 FORX=lTON 
9160 IFES(X)="S"ANDLA(X)>0THENLA(X)=LA(X)*-1ELSELA(X)=LA(X) 
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9178 IFF$(X)»"W"ANDDE(X)>0THENDE<X)=DE(X)*-1ELSEDE(X)=DE(X> 
9180 IPE$ (X) ="N"ANDLA(X) <0THENLA(X) =LA(X> *-lELSELA(X) =LA(X) 
9190 IFFS(X)="E"ANDDE(X)<0THBNDE(X)=DE(X)*-1ELSEDE(X)=DE(X) 
9200 NEXTX 
9205 INPUT'PRESS ENTER TO CONTINUE" ;Q$ 

9210 PRINTTAB(12)"UNADJUSTED";TAB(36) "ADJUSTED" 

9211 PRINTTAB(0) "COURSE" ;TAB(12) "LAT";TAB (24) "DEP";TAB<36) "LAT" ;TAB( 48 > "DEP" 
9240 FORX=lTON:LC=LC+LA(X) :DC=DC+DE(X) :NEXT 

9250 IFLC>0ANDDC>0THENLC=LC*-1:DC=DC*~1:GOTO9300 

9260 IFLC<0ANDDC<0THBNLC=LC*-1:DC=DC*-1:GOTO9300 

9270 IFLC<0ANDDO0THENLC=LC*-1:DC=DC*-1:GOTO9300 

9280 IFLO0ANDDC<0THENLC=LC*-1:DC=DC*-1:GOTO9300 

9300 FORX=lTON:CL=CL+L(X) :NEXT 

9340 F0RX=1T0N:LI(X)=LA(X) :DI(X)=DE(X) :NEXT 

9350 F0RX=1T0N:C(X)=(LC/CL)*L(X) :NEXT 

9390 FORX=lTON:D(X)=(DC/CL)*L(X) :NEXT 

9410 FORX=lTON:DE(X)=DE(X)+D(X) :NEXT 

9420 FORX=1TON:LA(X)=LA(X)+C(X) :NEXT 

9440 F0RX=1T0N:PRINTTAB(2)B$(X>;TAB(12)LI(X);TAB(24)DI(X);TAB(36>LA(X) *TAB(48)DE 

(X) :NEXT 
9445 PRINT 

9450 FORX=lTON:GH=GH+LA(X) :HG=HG+DE(X) :NEXT 
9455 FORX=1TON:HN=HN+LI(X) :NH=NH+DI{X) :NEXT 

9460 PRINTTAB(0) "TOTAL" ;TAB( 12) HN;TAB(24)NH;TAB(36)GH#;TAB(48)HG# 

9465 GOSUB21000 

9470 INPUT'DO YOU HAVE MORE CALCULATIONS" ;Q$ 

9480 IFQ$="Y"THEN10ELSEEND 

10000 CLS:PRINT" THIS PROGRAM WILL BALANCE BY COMPASS RULE ANY" 

10010 PRINT"TRAVERSE AS LONG AS ALL INTERIOR ANGLES AND ONE " 

10020 PRINT'BEARING ARE KNOWN. YOU WILL BE PROMPTED TO ENTER THE" 

10030 PRINT"NUMBER OF INTERIOR ANGLES, WHETHER THE INTERIOR ANGLES" 

10040 PRINT'ARE RIGHT OR LEFT ( R OR L ) AND WHAT THE KNOWN BEARING" 

10050 PRINT"IS. THE NUMBER OF INTERIOR ANGLES SHOULD BE GIVEN AS A" 

10060 PRINT"NUMBER BETWEEN THREE AND ONE HUNDRED. THE DIRECTION OF" 

10070 PRINT"THE INTERIOR ANGLES SHOULD BE ENTERED AS EITHER AN R FOR" 

10080 PRINT'ANGLES TAKEN IN A CLOCKWISE DIRECTION OR L FOR ANGLES" 

10090 PRINT'TAKEN IN A COUNTERCLOCKWISE DIRECTION. THE KNOWN " 

10100 PRINT"BEARING SHOULD BE ENTERED AS EX. S, 50,54 ,12, E. AFTER" 

10110 PRINT'ALL THIS INFORMATION IS ENTERED YOU WILL BE ASKED IF IT" 

10120 PRINT'IS CORRECT. IF IT IS THEN TYPE A Y, IF IT IS NOT CORRECT" 

10130 PRINT'THEN TYPE AN N." 

10140 INPUT"PRESS ENTER TO CONTINUE";Q$ 

10150 CLS:PRINT"IF ALL THE INFORMATION WAS CORRECT THEN THE SCREEN" 

10160 PRINT"WILL CLEAR AND YOU WILL BE ASKED TO INPUT THE STATION " 

10170 PRINT"NAME AND DEGREES, MINUTES AND SECONDS AND LENGTH OF THE SIDE." 

10180 PRINT"EX. IF YOU HAD A FOUR SIDED TRAVERSE AND IT WAS LABELED" 

10190 PRINT"AB,BC,CD,DA AND YOU KNEW THE BEARING OF AB THEN THE FIRST" 

10200 PRINT"ANGLE THAT YOU WOULD ENTER WOULD BE THE ONE TAKEN FROM" 

10210 PRINT'STATION B. IT IS IMPORTANT TO ENTER THE FIRST KNOWN " 

10220 PRINT"ANGLE FROM THE BEARING TAKEN IN A CLOCKWISE DIRECTION." 

10230 FORX=42T082:Y=28:SET(X,Y) :NEXT:FORY=28T036 :X=82:SET(X,Y) :NEXT:FOF«=82T042S 

TEP-l:Y=36:SET(X,Y):NEXT:FORY=36T028STEP-l:X=42:SET(X,Y) :NEXT 
10240 PRINT@537,"S,50,54,12,E";:PRINT@595,"A";:PRINTe618,"B";:PRINTe78'5' ,"D";:PRI 

NTe810,"C",-:PRINTe621,«lST ANG. ENTERED" ;: PRINT8813 , "2ND ANG. ENTERED" ;: PRI 

NT8576,"4TH ANG. ENTERED"; :PRINT8768, "3RD ANG. ENTERED"; 
10250 PRINT8832,"";:PRINT"THIS COMPLETES THE INSTRUCTIONS." 

10998 PRINT8896,"":INPUT"PRESS ENTER TO CONTINUE (THIS WILL BEGIN THE IPROGRAM)"; 
QS 

10999 RETURN 

11000 REM 

11005 CBS=C$+D$:GOSUB20000 

11010 FORX=lTON 

11020 E=E+180 

11025 IFE>=360THENE=E-360 

11030 GOSUB12000 

11040 GOSUB13000 

11050 GOSUB14000 

11060 IFX=NTHEN16000ELSENEXTX 

11070 REM 

12000 IFG-CUX0THEN12010ELSE12020 

12010 G=G+60:G=G-C(X) :F=F-1:GOTO12030 

12020 G=G-C(X) 

12030 IFF-B(X)<0THEN12040:ELSE12070 

12040 F=F+60:F=F-B(X) :E=E-1 

12050 IFE-A(X)<0THENE=E+360 

12060 E=E-A(X) :RETURN 

12070 IFS~A(X)<0THENE=E+360 

12080 E=E-A(X):F=F-B(X):RETURN 

13000 IFE>=0ANDE<90THENE$="N":F$="E":RETURN 

13010 IFE=90ANDF>0THENE$="S":F$="E":RETURN 

13020 IFE=90ANDF=0ANDG=0THENE$="N":F$="E":RETURN 

13030 IFE>90ANDE<180THENE$="S":F$="E":RETURN 

13040 IFE=180ANDF>0THENE$="S":FS="W":RETURN 

13050 IFE=180ANDF=0ANDG=0THENE$="S":F$="E":RETURN 

13060 IFE>180ANDE<270THENES="S":F$="W":RETURN 

13070 IFE=270ANDF>0THENE?="N":FS="W":RETURN 

13080 IFE=270ANDF=0ANDG=0THENE$="S":FS="W":RETURN 
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13090 IFE>270ANDE<360THENE$="N":F$="W":RETURN 

13100 IFE=360ANDF>0THENE$="N":F$="E":RETURN 

13110 IFE=360ANDF=0ANDG=0THENE$="N":F$="W":RETURN 

14 000 H=E:I=F:J=G:IFE>=0ANDE<=90THENE=E:F=F;GOTO14060 

14 010 IFE>90ANDE<180THENGOTO15000 

14020 IFE>=180ANDE<27 0THENGOTO15 020 

14 030 IFE>=27 0ANDE<=360THENGOTO1504 

14060 ES(X)=E$:E(X)=E:F(X)=F:G(X)=G:F$(X)=F$ 

14070 E=H:F=I:G=J 

14080 RETURN 

15000 E=180-E:IFF>0THENE=E-1:F=60-F 

15010 GOTO14060 

15020 E=E-180 

15030 GOTO14060 

1504 IFE=360THENE=0:F=F:GOTO14060 

15050 IFE<360ANDF>0THENE=359-E:F=60-F:GOTO14060 

16000 F0RX=1T0N 

16010 B$(X)=A$(X)+AS(X+1) 

16020 IFX<NTHENNEXTELSEB$ (X) =A$ (X) +A$ (1) 

16050 INPUT'PRESS ENTER TO CONTINUE" ;QS 

16055 CLS 

17000 F0RX=1T0N:PRINT"THE BEARING OF ";B$(X);" IS " ; E$ (X) ;E (X) ; F(X) ;G(X) ; F$ (X) :N 

EXT 
17010 FORX=lTON:Z(X)=E(X> :Y(X)=F(X) :X(X)=G(X) :NEXT 
17020 FORX=1TON:X(X)=X(X)/60:Y(X)=Y(X)+X(X):Y(X)=Y(X)/60:Z(X)=Z(X)+Y(X):Z(X)=Z(X 

)*.0174533:LA(X)=L(X)*COS(Z(X)} :DE(X) =L(X) *SIN(Z (X) ) :NEXT 
17 030 FORX=lTON 

17040 IFE5(X)="S"ANDLA(X)>0THBNLA(X)=LA(X)*-1ELSELA(X)=LA{X) 
17050 IFF$(X)="W"ANDDE(X)>0THENDE(X)=DE(X)*-1ELSEDE(X)=DE{X) 
17060 IFE$ (X) ="N"ANDLA(X) <0THENLA(X) =LA(X) *-lBLSELA(X) =LA(X) 
17070 IFF$(X)="E"ANDDE(XX0THENDE(X)=DB(X>*-1ELSEDE(X)=DB(X) 
17080 NEXT 

17090 INPUT'PRESS ENTER TO CONTINUE"jQ$ 
17100 PRINTTABU2) "UNADJUSTED";TAB(36) "ADJUSTED" 

17110 PRINTTAB(0)"COURSE";TAB(12)"LAT";TAB(24)"DEP";TAB(36)"LAT";TAB(48)"DEP" 
17120 F0RX=1T0N:LC=LC+LA(X) :DC=DC+DE(X) :NEXT 

17125 IFLC>0ANDDO0THBNLC=LC*-1:DC=DC*-1:GOTO17130 

17126 IFLC< 0ANDDC< 0THENLC=LC*-1 : DC=DC *-l : GOT017 130 

17127 IFLC<0ANDDO0THENLC=LC*-1:DC=DC*-1:GOTO17130 

17128 IFLO0ANDDC<0THENLC=LC*-1:DC=DC*-1:GOTO17130 
17130 FORX=lTON:CL=CL+L(X) :NEXT 

17140 FORX=lTON:LI(X)=LA(X) :DI(X)=DE(X) :NEXT 

17150 FORX=lTON:C(X)=.(LC/CL)*L(X) :NEXT 

17160 F0RX=1T0N:D(X)=(DC/CL)*L(X) :NEXT 

17170 F0RX=1T0N:DE(X)>=DE(X)+D(X) :NEXT 

17180 F0RX=1T0N:LA(X)=LA(X)+C(X) :NEXT 

17190 F0RX=1T0N:PRINTTAB(2)B$(X);TAB(12)LI(X);TAB(24)DI(X);TAB(36)LA(X);TAB(48)D 

E(X) :NEXT 
17200 PRINT 

17210 FORX=lTON:GH=GH+LA(X) :HG=HG+DE(X) :NEXT 
17220 FORX=lTON:HN=HN+LI(X) :NH=NH+DI(X) :NEXT 

17230 PRINTTAB(0)"TOTAL";TAB(12)HN;TAB(24)NH;TAB(36)GH;TAB(48)HG 
17235 GOSUB21000 

17240 INPUT'DO YOU HAVE MORE CALCULATIONS" ;Q$ 
17250 IFQ$="Y"THEN10ELSEEND 
19100 REM**** INITIAL AZIMUTH ROUTINE **** 
19110 REM**** IF INITIAL BEARING IN NE QUADRANT NO ACTION. IF IN SE QUADRANT SUB 

TRACT KNOWN BEARING FROM 180. IF IN SW ADD TO 180. IF IN NW SUBTRACT FROM 3 

60. 
20000 IFCB$="NE"THENRETURN 
20010 IFCB5="SE"THEN20020ELSE20050 
20020 IFG>0THENG=60-G : F=59-F : E=17 9-E : RETURN 
20030 IFF>0THENF=60-F : E=17 9-E : RETURN 
20040 E=180-E:RETURN 
20050 IFCB$="SW"THEN20060ELSE20080 
20060 E=E+180:RETURN 
20070 REM 

20080 IFCB$="NW"THEN20090ELSE20130 
20090 IFG>0THENG=60-G:F=59-F:E=359-E:RETURN 
20100 IFF>0THENF=60-F:E=359-E: RETURN 
20110 E=360-E: RETURN 
20120 END 
20130 CLS: PRINT "ERROR IN EITHER PREFIX OR SUFFIX OF THE BEARING" :FORX=1TO1000 :NE 

XT:GOTO10 
21000 INPUT'PRESS ENTER TO CONTINUE";AZ$ 
21010 CLS 
21020 FORX=lTON 
21030 AB(X)=DE(X) !AC(X)=LA(X) :AB(X)=AB(X) [ 2:AC (X) =AC (X) I 2 : AD (X) =AB(X) +AC (X) :AE(X 

)=SQR(AD(X)) 
21040 REM AE(X)= CORRECTED LENGTH 
21050 NEXTX 

21060 FORX=lTON 

21061 IFDE(XX0THENDE(X)=DE(X>*-1 

21062 IFLA(X)<0THENLA(X)=LA(X)*-1 
21070 AF(X)=DE(X)/LA(X) 

21080 AG(X)=ATN(AF(X)) 
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21090 AG(X)»AG(X)*57. 29578 

21100 REM AG(X) = THE DECIMAL DEGREES 

21110 NEXT 

21115 F0RX=1T0N 

21120 AH(X)=INT(AG(X)) 

21130 A1(X)=AG(X) 

21140 AI(X)=AI(X)-INT(AI(X)) 

21150 AI(X)=AI(X)*60 

21160 AJ(X)=INT(AI(X)) 

21170 AK(X)=AI(X)-INT(AI(X>) 

21180 AK(X)=AK(X)*60 

21200 PRINT"THE CORRECTED BEARING OF ";B$(X>;* IS ",-E$ (X) ; AH(X) ;AJ(X) ;AL(X) |F$(X 

21205 PRINT"AND THE CORRECTED LENGTH OF ";B$(X);" IS ";AE(X> 

21210 PRINT 

21230 NEXT 

21240 RETURN 

22000 FORX=1TON:A(X)=0:B(X)=0:C(X)=0:D=0:M=0:S=0:NEXT:CLS:GOTO31 



TAX WITHOLDING: by Cliff De Jong 



This program- will be useful to 
the small businessman or self- 
employed computer specialist at 
tax time. All considerations the 
IRS finds interesting are taken 
into account. A full-page display 
of tax specifics at program's end. 



"'mUIttlUTY* 3837 M 1.1WI 

FIX WE WJCP t I 

'pBfTlWSMMj' '-'- ' WOT. . '. T8THK1W. 
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5 DIMTL(15),TA(16),TB(16),WL(6),WB(7),SD(1),TW(1),NM(1),EC(1),W(1) 

7 CLS-PRINT"FILING STATUS 1 :INPUT'S"SINGLE OR M=MARRIED FILING JOINTLY";F$:IFF$=' 

S"THENJ=1ELSEJ=0 

8 REM READ TAX AND WITHHOLDING TABLES 
10 FORFS=0TOJ 

20 FORI=0TO14+FS:READTL(I):NEXT 

30 F0RI=1T015+FS:READTA(I) :NEXT 

40 F0RI=1T015+FS:READTB(I):NEXT 

50 FORI=0TO6:READWL(I) :NEXT 

60 F0RI=1T07:READWA(I) :NEXT 

70 F0RI=1T07:READWB(I):NEXT:NEXTFS 

80 SD(0)=3400:SD(1)=2300:FS=J 

90 REM GET INPUTS 

120 INPUT"WAGES(tl)";W(0):INPUT"WAGES(*2)";W(l) 

130 INPUT"OTHER INCOME" ;OI:GI=W(0) +W(1)+0I 

140 INPUT"ITEMIZED DEDUCTIONS" ;D:D=D-SD(FS) : IFD<0THEND=0 

145 INPUT"TAX CREDITS" ;TC 

150 INPUT'ACTUAL EXEMPTIONS" ; AE:TI=GI~D-AE*1000 

160 FORI=0TO1:IFW(I)=0THEN200 

165 PRINT'FOR WAGE EARNER l",I+l 

170 INPUT" TAX WITHHELD TO DATE",-TW(I) 

180 INPUT" NUMBER OF MONTHS" ;NM(I) 

190 INPUT" CURRENT EXEMPTIONS CLAIMED" ; EC ( I) 

200 NEXTI 

205 REM PRINT WITHHOLDING TABLES „,„„„ ., 

210 CLS:GOSUB21040:TX=TX-TC:PRINT"TAX LIABILITY=" ,TAB(16) TX,TAB( 43) TB ( I) *100, % 

BRACKET" 
220 FORJ=0TO1:IFW(J)=0THEN240 
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230 WI=W(J)-EC(J)«1000:GOSUB31040:A(J)=AW 
240 NEXTJ 

250 FORJ=0TO1:IFW(J)=0THEN320 
260 PRINT677,"FOR WAGE EARNER »",J+1 

265 PRINT-EXEMPTIONS CLAIMED", "REFUND", "TAKE HOME INCR" 
270 K=0:IFJ=0 K=l 

280 FORE=0TO10:WI=W(J)-E*1000:GOSUB31040 
290 PW=TW(J)+AW«(1-NM(J)/12)+TW(K)+A(K)*(1-NM(K)/12) 
295 R»=PW~TX:TH%=(A(J)-AW)/52 
300 PRINTTAB(7)E,TAB(31)RS,TAB(52)TH%:NEXTE 
310 IFW(1)O0ANDJ=0INPUT"PRESS ENTER TO CONTINUE"iF$ 
320 NEXTJ 
330 END 

9990 REM TAXAND WITHHOLDING TABLES 

10000 DATA3400, 5500, 7600, 11900,16000, 20200, 24600, 29900 35200 
09400,162400,215400 °ob,«s»»,«^b», 

10010 DATA0, 294,630, 1404, 2265, 3273, 4505, 6201, 8162, 12720, 19678 
117504 

10020 DATA. 14, .16, .18, .21, .24, .28, .32, .37, .43, .49, .54, .59 64 

10030 DATA2400, 6600, 10900, 15000, 19200, 23600, 28900 ""'•« 

10040 DATA0, 630, 1404, 2265, 3273, 4505, 6201 

10050 DATA. 15,. 18,. 21,. 24,. 28,. 32,. 37 

10060 DATA2300, 3400, 4400, 6500, 8500, 10800, 12900, 15000, 18200 23 

00,55300,81800,108300 ' 

10070^^154, 314, 692, 1072, 1555, 2059, 2605, 3565, 5367, 7434, 97 

10080 DATA.14,. 16,. 18,. 19,. 21,. 24,. 26,. 30,. 34,. 39,. 44,. 49,. 55 

10090 DATA1420, 3300, 6800, 10200, 14200, 17200, 22500 '•"■■^ 

10100 DATA0, 282, 912, 1626, 2666, 3566, 5368 

10110 DATA. 15,. 18,. 21,. 26,. 3,. 34,. 39 

21030 REM SUB 21340 ESTIMATES TAX LIABILITY TX 

21035 REM FOR TAXABLE INCOME TI 

21040 IFTKTL(0)TX=0:RETURN 

21050 FORI=1TO14+FS:IFTKTL(I)THEN21070 

21060 NEXTI:I=15+FS 

21070 TX=TA{I)+TB(I)*(TI-TL(I-1)):RETURN 

31030 REM SUB 31040 ESTIMATES ANNUAL WITHHOLDING AW 

31035 REM FOR WITHHOLDING INCOME WI 

31040 IFWKWL(0)AW=0: RETURN 

31050 FORI=1TO6:IFWKWL(I)THEN31070 

31060 NEXTI:I=7 

31070 AW=WAU)+WB(I)*<WI-WL(I-1)):RETURN 



45800, 
,33502 
,.68,. 

500,28 

66,133 

.63,. 



100,85600,1 
544,81464, 



,34100,415 
20982,3767 

.7 



GRADE BOOK: by Anne Weiss 



The teacher's choice. This pro- 
gram will compute quarterly, se- 
mester or yearly grade averages. 
Grades can be weighted and/or 
converted to a base of 100 per- 
centage points. All entries can be 
easily changed or corrected and 
are displayed in actual grade- 
book format. The only thing left 
undone is tomorrrow's lesson 
plan. 




10 REM *********.» 
15 REM * * * GRADES *»*..* 
25 REM ****»»**«*» 
30 CLS:INPUT"ENTER 1 FOR DIRECTIONS, TO PROCEED" ;Q: IFQ=1THEN850 
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40 DEFINTA-Z 

50 DATA "TESTS", "QUIZZES", "HOMEWORK", "CLASSWORK", "PROJECTS" 

60 DATA "SEMESTER EXAM", "1ST OR 3RD QUARTER", "1ST SEMESTER AVERAGE" 

70 DATA "YEARLY EXAM", "THIS QUARTER", "", "THIS SEMESTER" 

75 DIMA$(11),C(11),G1(11) 

80 FORI=0TO11:READA$(I) :NEXT 

90 CLS 

100 PRINT"HOW MANY GRADES OF EACH TYPE WILL YOU ENTER?" :PRINT 

110 FORI=0TO8:PRINTA$(I):NEXT:PRINTei28,""i 

120 FORI=0TO 8:PRINTA$(I)(TAB(25)"";:INPUTN(I):NEXT 

130 FORI=0TO4:T=T+N(I) :NEXT:PRINT 

140 PRINT"! WILL COUNT ONLY THE FIRST";T;" GRADES FOR THIS QUARTER" 

150 INPUT'ENTER 1 TO PROCEED, TO RECOUNT GRADES ";Q 

160 IFQ=0THENT=0:GOTO90 

165 DIMR(T),G(T),B(T) 

170 CLS 

180 PRINTTAB(30)"DO YOU WANT TO" 

190 PRINT"1 COU1IT ALL GRADES THE SAME WEIGHT" ;TAB(50) "OR" 

200 PRINT"2 WEIGHT THEM DIFFERENTLY" 

210 INPUT'ENTER 1 OR 2 "jQl 

220 PRINT 

230 PRINT'HAVE YOUR GRADES BEEN SCORED ON OR CONVERTED TO A BASIS OF" 

240 INPUT"1=100 POINTS EACH 2=NOT ALL ON 108 POINTS ";Q2 

250 PRINT:FOR I=1TOT:IFQ2=1THENB(I)=100:GOTO270 

260 PRINT"ENTER THE TOTAL SCORE POSSIBLE FOR GRADE #";I; : INPUTB(I) 

270 IFQ1=1THEN310 

280 PRINT'DOES GRADE #";!;" REPRESENT T,Q,H,C,P " ; : INPUTTS 

290 R{I)=-l:FORL=BT05:IFT$=LEFT$(A$(L),l)THENR(I)=L 

300 NEXT:IFR(I)=-1PRINT"ERR0R-TRY AGAIN" :GOTO280 

310 NEXT 

320 FOR I=5TO8STEP3:IFN(I)=0THENB1(I)=1:GOTO350 

330 IFQ2=1THENB1(I)=100:GOTO350 

340 PRINT"ENTER THE TOTAL SCORE POSSIBLE FOR " ; A$(I) ; : INPUTB1 (I) 

350 NEXT:IFQ1=1THEN415 

360 PRINT:FORI=0TO4:IFN(I)=0THENC(I)=0:GOTO390 

370 PRINT'WHAT PER CENT DOES ";A$ (I) ; : INPUT" COUNT THIS QUARTER ",-C(I) 

380 P=P+C(I) 

390 NEXT: PRINT 

400 IFP>99ANDP<101THEN415 

405 PRINT'ERROR - DOESN'T TOTAL 100 PER CENT - TRY AGAIN" 

410 P=0:GOTO360 

415 P=0:IFN(6)=0THEN427 

420 X=5:GOSUB780:IFN(7)=0THEN427 

425 X=7:GOSUB780 

427 INPUT'PUSH ENTER TO RECORD GRADES ";Q 

430 P1=100:CLS:T1=T:G=0:FORI=0TO4:N1(I)=N(I) :Y(I) =0:NEXT 

440 PRINT"TYPE IN GRADES AND PUSH ENTER KEY AFTER BACH ONE" 

450 PRINT"A GRADE OF -1 WILL BE DROPPED FROM THE AVERAGE" 

460 PRINT"A GRADE OF WILL BE COUNTED AS A ZERO" 

465 PRINT'ENTER A GRADE OF -2 IF YOU MAKE AN ERROR" :PRINT 

470 FORK=1TOT 

480 PRINTe5*64+16*K-16,"#";K; 

490 INPUT G(K) 

495 IFG(K)=-2THEN430 

500 IFG (K) =-lTHENNl (R(K) ) =N1 (R(K) ) -1:T1=T1-1:GOTO540 

510 G(K)=100*G(K)/B(K)+.5 

520 IFQ1=1THEN540 

530 Y(R(K))=Y(R(K))+G(K) 

540 NEXT:IFQ1=1THEN580 

550 FORJ=0TO4:IFN(J)=0THEN570 

555 IFN1(J)=0THENP1=P1-C(J) :GOTO570 

560 Y(J)=Y(J)*C(J)/N1(J) :G=G+Y(J) 

570 NEXT:G1(9)=G/P1+.5:GOTO610 

580 FORK=1TOT:IFG(KX0THEN600 

590 G=G(K)+G 

600 NEXT:GM9)=G/Tl+.5 

610 PRINT: PRINT"THE AVERAGE FOR ";A$(9);" IS "iGl(9) 

620 IFN(6)=0THEN760 

630 Pl=100 : FORI=5T06 : IFN ( I) =0THENG1 ( I) =0 :GOTO650 

640 PRINT'ENTER GRADE FOR " ; AS (I) ; : INPUTG1 ( I) 

645 IFG1(I)=-1THENP1=P1-C(I> :G1(I)=0 

648 IFG1(I)=-2THEN630 

650 NEXT 

660 G=G1(5)*C(5)*100/B1(5)+G1(6)*C(6)+G1(9)*C(9) 

670 Gl(ll)=G/Pl+.5 

680 PRINT: PRINT"THE AVERAGE FOR THIS SEMESTER IS";G1(11) 

690 IFN(7)=0THEN760 

700 P1=100:FORI=7TO8:IFN(I)=0THENG1(I)=0:GOTO720 

710 PRINT'ENTER GRADE FOR " ; A? (I) ; : INPUTG1 ( I] 

715 IFG1(I)=-1THENP1=P1-C(I) :G1(I)=0 

718 IFG1(I)=-2THEN700 

720 NEXT 

730 G=G1(7)*C(7)+G1(8)*C(8)*100/B1(8)+G1(11)*C(11) 

740 G=G/Pl+.5 

750 PRINT:PRINT°THE AVERAGE FOR THE YEAR IS ",-G 

760 INPUT"PUSH ENTER TO AVERAGE MORE GRADES, PUSH BREAK TO STOP'iQ 

770 GOTO430 
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7 80 FORI =XTOX+l : IFN ( I ) =0THENC ( I ) =0 : GOTO810 

790 IFX=7THEN82 

800 PRINT"WHAT PER CENT DOES " ; AS ( I ) ; : INPUT" COUNT THIS SEMESTER ";C(I) 

810 GOTO830 

820 PRINT"WHAT PER CENT DOES " ;A$ ( I) ; : INPUT" COUNT FOR THE YEAR ";C(I) 

830 P=P+C(I) :NEXT 

840 C(X+4)=100~P:P=0:RETURN 

850 CLS:PRINTTAB(30) "GRADES": PRINT 

860 PRINT"THIS PROGRAM WILL COMPUTE QUARTER, SEMESTER OR YEAR AVERAGES" 

870 PRINT: PRINT"YOU MAY COUNT ALL GRADES EQUALLY, OR YOU MAY" 

880 PRINT"WEIGHT THEM BY DIFFERENT PER CENTAGES" :PRINT 

890 PRINT'THE PROGRAM WILL CONVERT ALL GRADES TO A BASIS OF 100" 

900 PRINT: PRINT"IF YOU ENTER A 0, THE GRADE WILL BE COUNTED AS ZERO" 

910 PRINT'IF YOU ENTER A -1, THE GRADE WILL NOT BE COUNTED" 

920 PRINT"ENTER A -2 TO CORRECT A WRONG GRADE" 

930 PRINT: PRINT"ENTER THE GRADES JUST AS THEY APPEAR IN YOUR BOOK" 

940 PRINT: INPUT'PUSH ENTER TO BEGIN", -Q 

950 GOTO40 



BUSINESS INFORMATION MANAGEMENT SYSTEM: 
by George Doss 



Keep track of any kind of 
business data with this nifty pro- 
gram. Data can be loaded via 
tape and accessed by video ter- 
minal. Sort, list, update and 
deletion routines are included. 
Makes record keeping a snap. 
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7- SUt IMA OH FILE 
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20 CLEAR6000:DIMPR$(100):DIMK$U00):DIMK(100) 

30 CLS:PRINT:INPUT"DO YOU HAVE OLD DATA TO LOAD? 1=YES 2=NO" ;IP: IFIP=1THEN290 

40 IFIP>2GOTO30 

50 CLS:PRINTTAB(2) "ENTER COLUMN HEADINGS (MAX 60 SPACES)" 

60 INPUTCHS 

70 PRINTTAB(2)"ENTER NEW RECORDS. TO STOP ENTERING PROCEDURE ENTER END" 

80 PRINTTAB{2)CHS 

90 FORR=1TO100 

100 INPUTPR$(R) 

110 IFPR$(R)="END"GOTO130 

120 NEXT 

130 NR=R-1:GOTO140 

140 CLS:PRINT:PRINTTAB(7) "PERSONAL/SMALL BUSINESS INFORMATIONAL MANAGEMENT SYSTE 

M " 
150 PRINT:PRINTTAB(23)"— TABLE OF CONTENTS—" 
160 PRINTTAB{22)"1- ADD NEW DATA TO FILE" 
170 PRINTTAB{22)"2- DELETE DATA ON FILE" 
180 PRINTTAB(22) "3- LIST DATA ON FILE" 
190 PRINTTAB(22)"4- SAVE DATA ON FILE" 
200 PRINTTAB(22)"5- SEARCH DATA ON FILE" 
210 PRINTTAB(22) "6- SORT DATA ON FILE" 
220 PRINTTAB(22)"7- SUM DATA ON FILE" 
230 PRINTTAB(22)"8- UPDATE DATA ON FILE" 
260 PRINTTAB{22)"9- END" 
270 PRINT:PRINTTAB(8) :INPUT"TYPE THE APPROPRIATE NUMBER AND PRESS <ENTER>" ; IP : IF 

IP>11GOTO140 
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280 ONIPGOTO330 ,1000 ,420 ,1240 ,1130 ,1350 ,1150 ,880 ,1320 
290 CLS: INPUT" PRESS <ENTER> WHEN TAPE IS PREPARED" ; IP 
300 CLS:INPUT#-1,CH$:PRINTCHS 
310 INPUT#-1,NR:PRINTTAB(60)NR 

320 F0RR=1T0NR:INPUTS-1,PR?(R):PRINTPR5(R):NEXT 

321 GOTO140 

330 REM *** ADD ROUTINE *** 

340 PRS(R)=PR$(R) 

350 AN$="":CLS:PRINTTAB(2)"ENTER NEW RECORD." 

360 PRINTTAB(2)CH? 

370 INPUTPR$(NR+1) 

380 NR=NR+1 

400 INPUT"DO YOU WANT TO ADD ANOTHER RECORD? (Y OR N)";AN$ 

410 IFAN$="Y"THEN350 ELSE140 

420 REM *** LIST DATA ROUTINE *** 

430 R=1:CLS: INPUT-ENTER MODE: A(ALL), O(ONB), R(RANGB) " ; AN$ 

440 IFAN$="A"THEN480 

450 IFAN?="O"THEN600 

460 IFAN$="R"THEN680 

470 IFAN$O"A"ORAN$<>"O"ORAN$<>"R"THEN430 

480 FL=0lAAS="":CLS:INPUT"ENTER THE LENGTH OF THE FIRST FIELD" ; FL: INPUT"DO YOU W 

ANT THE DATA LISTED TO VIDEO OR PRINTER (V OR P)";AAS 
490 IFAA$="P"THEN546 
500 PRINT :PRINTCHS:FORR=lTONR 
510 IFPR$(R)O""THEN530 
520 IFPR$(R)=""NEXT:GOTO540 

540 PRlEpRINT'NUMBER OF RECORDS = " ;NR: PRINT: INPUT" PRESS <ENTER> TO CONTINUE"; 

E* GOTO140 
546 CLS:INPUT"IS THE PRINTER READY? (Y OR N) " ; IP$ : IFIPS="Y"550ELSE480 
550 LPRINTCHS:LPRINTCHR$<10) :FORR=lTONR 
560 IFPR?(R)O""THEN580 
570 IFPR$(R)=""NEXT:GOTO590 

590 LPMNTCHRlu^iLraiNT'NUMBER OF RECORDS = ■ ;NR: PRINT: INPUT"PRESS <ENTER> TO 

600 FV$=""™LsipRINTTAB(2):INPUT"ENTER FIELD VARIABLE TO BE IDENTIFIED. FOR EXAM 

PLE, A SPECIFIC CODE OR NUMBER" ;FV$ 
610 GOSUB770 

620 KS=0:KL=0:AN?="":INPUT"ENTER KEY START POSITION, LENGTH";KS,KL 
628 CLS:PRINTCH$ 
630 FORR=lTONR 

640 IFMID$(PR$(R),KS,KL)=FV$THEN660 
650 IFFV$OMID$(PR$(R),KS,KL)NEXT:GOTO670 

670 PRINT^INPUT"DO X YOU WANT TO SEE ANOTHER RECORD? (Y OR N) " ;AN$: IFAN?="Y"THEN60 

ELSE140 

680 KS=0:KL=0:AN$="":CLS:GOSUB770 :REM RANGE SUBROUTINE 

690 INPUT"ENTER KEY START POSITION, LENGTH" ;KS,KL 

700 INPUT'ENTER LOWER BOUND";LB 

710 INPUT"ENTER UPPER BOUND";UB 

718 CLS:PRINTCH$ 

720 FORR=lTONR 

730 IFVAL(MID$(PRS(R),KS,KL))>UBNEXT:GOTO760 

740 IFVAL(MID${PRS(R) ,KS,KL) ) <LBNEXT:GOTO760 

760 PRINT: INPUT"DO YOU WANT TO SET DIFFERENT BOUNDS? (Y OR N) ";AN$:IFAN$="Y"THEN 

680 ELSE140 • 

770 CLS:PRINT"KEY TABLE (KEY START POSITION, LENGTH)" 
7 80 PRINTMIDS(CHS,1,5);TAB(12)"1,5" 
790 PRINTMID$(CHS,8,7) ;TAB(12) "8,7" 
800 PRINTMID$(CHS,17,7) ;TAB(12) "17 ,7 " 
810 PRINTMID$(CHS,26,7) ;TAB(12) "26 ,7" 
820 PRINTMID$(CH$,35,7) ;TAB(12) "35,7" 
830 PRINTMID$(CH$,44,7);TAB(12)"44,7" 
840 PRINTMID$(CHS,53,8);TAB(12)"53,8" 
870 RETURN 

880 REM *** UPDATE ROUTINE *** „„„ 

890 ANS="":AA$="":FV$="":FL=0:CLS:PRINTTAB(2):INPUT"ENTER FIRST FIELD OF RECORD 

TO BE UPDATED" ;FV$ 
900 PRINTTAB(2) :INPUT"ENTER FIRST FIELD LENGTH";FL 
910 FORR=lTONR 

920 IFLEFT${PRS(R) ,FL) =FVSTHEN940 
930 IFFV?OLEFT$(PRS(R),FL)NEXT:GOTO990 
940 PRINTTAB(2)PR$(R) 
960 PRINTTAB(2)"ENTER ALL DATA FOR THE RECORD BEING UPDATED" : PRINT: PRINTTAB(2)CH 

$ 
980 PRINT!lNPUT"DO YOU WANT TO UPDATE ANOTHER RECORD? (Y OR N) " ; AN? : IFANS="Y"THE 

990 PRINT- PR$1r)=PR$(R+D:INPUT"NOT ON FILE. DO YOU WANT TO TRY ANOTHER RECORD? 
(Y OR N)";AA$:IFAA5="Y"THEN890 ELSE140 

iSSS R™:r S =""S="":S="":FL= a :FD S ="" = CLS:PRINTTAB(2,:INPUT"ENTER FIELD OF R 

ECORD TO BE DELETED" ;FDS 
1020 PRINTTAB(2):INPUT"ENTER FIRST FIELD LENGTH";FL 
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1030 F0RR=1T0NR+D 

1040 IFLEFT$ (PR$ (R) ,FL) =FD$THEN1060 

1050 IFFD$OLEFT$(PR$(R) ,FL) NEXT:GOTO1120 

1060 PRINTTAB(2)CH$ 

1070 PRINTTAB(2lPR$(R) 

1080 PRINT: INPUT"DO YOU WANT TO DELETE THIS RECORD? (Y OR N) " ;AN$ : IFAN$=»Y"THENP 

RS (R) — ELSE1100 
1090 PRS(R)=PR$(NR) :D=D+1:NR=NR-1 

1100 INPUT'DO YOU WANT TO DELETE ANOTHER RECORD? (Y OR N)":AAS 
1110 IFAA$="Y"THEN1010 ELSE140 
1120 PRINT: INPUT'NOT ON FILE. DO YOU WANT TO TRY ANOTHER RECORD? (Y OR N)"-ARS-T 

FABS="Y"THEN1010 ELSE140 ' ■ AB: >- 1 

1130 REM *** SEARCH ROUTINE *** 
1140 COTO600 

1150 REM *** SUM OF DATA ROUTINE *** 
1160 CLS:KS=0:KL=0:SM#=0:FT#=0:GOSUB770 
1170 INPUT "ENTER KEY START POSITION, LENGTH" ;KS,KL 
1180 FORR=lTONR 

1190 FT#=VAL(MID$(PRS(R) ,KS,KL)) 
1200 SM#=SM#+FTS 
1210 NEXT 

1220 PRINT"SUM OF ";MID$ (CHS,KS,KL) " EQUALS ";SM» 
1230 PRINT: INPUT"DO YOU WANT TO SUM ANOTHER FIELD? (Y OR N) " ;AN$ : IFANS="Y"THEN11 

60 ELSE140 ,™i*.xrnn ? i ihhn.ii 

1240 REM *** SAVE ROUTINE *** 

1250 CLS:INPUT"PREPARE THE RECORDER. PRESS <ENTER> WHEN READY";E 

1260 CLS:PRINT:PRINTCHR$(23):PRINTTAB(10)"DATA LOADING" 

1270 PRINT#-1,CHS 

1280 PRINT*-1,NR 

1290 FORR=lTONR:PRINT#-l,PR$(R) :NEXT 

1300 PRINT:PRINTTAB(10)"END OF FILE" 

1310 CLS:GOTO140 

1320 REM ***END ROUTINE *** 

1330 CLS:INPUT"HAVE YOU SAVED THE FILE? (y OR N)";ANS 

1340 IFAN$="N"THEN1240 ELSEEND 

1350 REM *** SORT ROUTINE *** 

1360 KS=0:KL=0:ANS="":GOSUB770 

1370 INPUT"ENTBR KEY START POSITION, KEY LENGTH ",- KS , KL 

1380 FORR=lTONR 

1390 K(R)=R:K$(R)=MID$(PR$(R),KS,KL) 

1400 NEXT 

1410 INPUT"SORT TITLE: ";TI$ 

1412 «!$="" :INPUT"DO YOU WANT THE SORT IN ASCENDING ORDER (LOW TO HIGH) OR IN DE 
SCENDING ORDER (HIGH TO LOW)? ENTER LH OR hl";AN$ 

1414 IFAN$="HL"GOTO1570 

1416 IFAN$="LH"GOTO1680 

1430 INPUT"DO YOU WANT THE SORT ON VIDEO OR PRINTER (V OR P)"-AN$ 

1440 IFAN$="VGOTO1460 

1450 IFAN$="P"GOTO1508 

1460 CLS:PRINTTAB(10)TIS:PRINTCH$ 

1470 FORR=lTONR:F=K(R) :PRINTPR$(F) : NEXT 

1480 PRINT: INPUT"ANOTHER SORT (Y OR N) : ";AAS 

1490 IFAA$="Y"GOTO1360 

1500 IFAA$="N"GOTO140 

1508 CLS:INPUT"IS THE PRINTER READY? (Y OR N) ",-IUS: IFIU$="y"1510ELSE1430 

1510 LPRINTTI$:LPRINTCHR$(10):LPRINTCH$ uamjv 

1520 FORR=lTONR:F=K(R) :LPRINTPR$(F) :NEXT 

1530 GOTO1480 

1570 NN=NR:NN=NN+1:E=1:F=1 

1580 CLS : PRINT: PRINTTABI 20) "NOW SORTING" 

1590 NN=NN/2:NN=INT(NN) 

1600 IFNN=0:GOTO1670 

1610 D=NR-NN 

1620 FORL=lTOD:E=L+NN:K$=K$(E) :K=K(E):F=L 

1630 IFK$(F)=>K$GOTO1660 

1640 E=F+NN:K$(E)=KS(F) :K(E)=K(F) :F=F-NN 

1650 IFF>0GOTO1630 

1660 E=F+NN:K$(E)=KS:K(E)=K:NEXTL:GOTO1590 

1670 GOTO1430 

1680 NN=NR:NN=NN+1:E=1:F=1 

1690 CLS:PRINT:PRINTTAB(20)"NOW SORTING" 

1700 NN=NN/2:NN=INT(NN) 

1710 IFNN=0GOTO17 80 

17 20 D=NR-NN 

1730 FORL=lTOD:E=L+NN:KS=KS(E) :K=K(E) :F=L 

1740 IFK5(F)<=K$GOTO1770 

1750 E=F+NN:K$(E)=K$(F) :K(E)=K(F) :F=F-NN 

1760 IFF>1GOTO1740 

1770 E=F+NN:K$(E)=KS:K(E)=K:NEXTL:GOTO1700 

17 80 GOTO1430 
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CASH REGISTER: by John Hamilton 



Keep an electronic record of 
all cash drawer transactions and 
have a hard copy output avail- 
able for your records. Useful 
when the tax man extracts his 
pound of flesh. 



*SIU TOT*. MBItf TOTALS OttSTIUTIlK MMX. 'Ml 
E=«0fIT 

(8.99 mWAXMI SWOT* 

ra.ee Tiwai sunn*. 



».ee tot* 

IS THIS A DWGE SflU ? . 



10 

20 

40 

50 

60 

70 

60 

90 

100 

110 

120 

130 

140 

150 

160 

170 

180 

190 

200 

210 

220 

230 

240 

250 

26 

27 
280 
290 
300 
310 
320 
330 
340 
350 
360 
370 
380 
390 
400 
410 
420 
430 
440 
450 
460 
470 
480 
490 
500 
510 
520 
530 
540 
550 
560 
570 
580 
590 
600 



CASHREGISTER PROGRAM 



THIS PROGRAM IS DESIGNED TO EMULATE A CASHREGISTER 



'VARIABLES: 



NAME 



FUNCTION 



A{ 
AA 
B( 
C( 



CT 

CV 

D 

DA 

DB 

E 

I 

J( 

K 



DEPARTMENT ABBREVIATION 

BUSINESS NAME 

EMPLOYEE ID 

DEPARTMENT CODE 

CASSETTE DATA TRANSFER STRING VARIABLE 

CASSETTE DATA TRANSFER STRING VARIABLE 

CASSETTE DATA TRANSFER STRING VARIABLE 

CHARACTER INPUT VARIABLE 

CHARACTER OUTPUT VARIABLE (CHARGE OR CASH) 

DATE 

DOLLAR OUTPUT FORMAT 

LOOP COUNTER AND SUBSCRIPT VARIABLE 

DEPARTMENT TAXIBILITY (1=YES 0=NO) 

EMPLOYEE SALES TOTALS SUBSCRIPT 

SALE ITEM COUNT 

SALES SLIP COUNT 

SCREEN PRINT POSITION 

PRINTER REQUEST 

PRINTER REQUEST 

INPUT CHARACTER VARIABLE 

SCREEN PRINT POSITION 

NUMBER OF DEPARTMENTS 

SUBSCRIPT VARIABLE 

CASSETTE LOAD COUNTER 

CASSETTE DUMP FLAG 

CASSETTE DATA TRANSFER VARIABLE POINTER 

POSITION POINTER 

PRINTER BUFFER OF DEPT. SALES 

SALES TAX PERCENTAGE 

RUNNING TOTAL OF CHARGE SALES 

RUNNING TOTAL OF SALES TAX 

DECIMAL ADJUST 

DECIMAL ADJUST 

ITEM PRICE 

QUANTITY COUNT 

SALE NONTAXABLE SUBTOTAL 

SALE TAXABLE SUBTOTAL 

SALES TAX AMOUNT 

DEPARTMENT TOTALS 

SALESPERSON SALE TOTALS 

AMOUNT RECEIVED 

DAILY NONTAXABLE SUBTOTAL 
• ZT DAILY TAXABLE SUBTOTAL 
' *** INITIALIZATION *** 

CLEAR 2000 

DEFINT I-N:DEFSTR A-E 
E="$S*#*»f .##" 

DIM A(22),B{20),C(22),J(22),X<22),Y(20>,P(50,2) 
FOR 1=1 TO 22:C(I)=CHK$(I+68) :NEXT I 



LQ 

LQ$ 

M 

N 

NA 

NB 

NC 

NN 

P 

P( , 

T 

TC 

tt 

U 

V 

W 

Wl 

WS 

WT 

WV 

X( ) 

Y( ) 

z 

ZN 
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610 CLSiPRINT TAB(20) "CASH-REGISTER PROGRAM 1.0":PRINT " " 

620 INPUT "IS A PRINTER TO BE USED ";LQS 

621 IF LEFT$(LQ$,1)="N" THEN GOTO 630 

625 QQ=PEEK(14312) 

626 IF QQ=63 THEN 630 

627 PRINT "CHECK TO SEE IF YOUR PRINTER IS CONNECTED AND ON.":GOTO 625 
630 IF LEFT$(LQ$,1)="Y" THEN LQ=1 ELSE LQ=0 

640 IF LQ=1 THEN LPRINT CHRS(30) 

650 INPUT "IS CASSETTE TO BE USED FOR DATA STORAGE ";NC$ 

660 IF LEFTS(NC$,1)="Y" THEN NC=1 ELSE NC=0 

670 INPUT "WHAT IS THE BUSINESS NAME ";AA 

680 INPUT "WHAT IS TODAY'S DATE ";DB 

690 ' *** DEPARTMENTAL CODE ASSIGNMENT*** 

700 PRINT "HOW MANY TYPES OF TRANSACTIONS (I.E. RENT, REC ON ACCT, MISC) " 

710 INPUT " DO YOU WISH TO USE ";N 

720 CLS: PRINT "ENTER A DESCRIPTIVE CODE FOR EACH TYPE; MAX OF 12 LETTERS." 

730 PRINT "ANSWER SALES TAX QUESTION WITH Y OR N WHEN IT APPEARS." 

740 FOR 1=1 TO N 

750 L=68+I*64 

760 IF L>960 THEN L=900 

770 PRINT C(I);" =" 

780 D=INKEY$:IFD=""THEN GOTO780 

800 IF ASC(D)=13 THEN GOTO 850 

810 IF ASC(D)=8 THEN A( I) =LEFTS (A( I) ,LEN (A(I) ) -1) :L=L-1 : PRINT g L," ":GOTO 780 

820 PRINT 6 L,D:L=L+1 

830 A(I)=A(I)+D 

840 GOTO 7 80 

850 L=L+2 

860 PRINT @ L,": SALES TAX "; 

870 INPUT D$ 

880 IF LEFTS (D$,1)="Y"THEN J(I)=l:GOTO 920 

890 IF LEFTS(DS,1)="N"THEN J(I)=0:GOTO 920 

910 GOTO 870 

920 L=L+12 

940 NEXT I 

950 INPUT "WHAT PERCENTAGE IS THE SALES TAX ",-T 

960 T=T*.01 

970 NC$="" 

980 INPUT "IS ANY DATA TO BE ENTERED FROM CASSETTE ";NCS 

990 IF LEFT$(NC$,1)="N" THEN GOTO 1180 

1000 INPUT "HOW MANY TRANSACTION ARE TO BE READ FROM CASSETTE ";NB 

1010 INPUT "CASSETTE READY TO PLAY BACK DATA ";NC$ 

1020 FOR 1=1 TO NB 

1030 INPUT#-1,K,TC,TT,ZN,ZT,WS,WT,CR,KP 

1040 B(K)=CR 

1050 Y(K)=Y(K)+WS+WT 

1060 INPUT#-1,CR,CF 

1070 P=l 

1080 GOSUB 2920 

1090 NN=VAL(CT) 

1100 FOR 11=1 TO NN 

1110 GOSUB 2920 

1120 NA=VAL(CT) 

1130 GOSUB 2920 

1140 X(NA)=X(NA)+VAL(CT) 

1150 NEXT II 

1160 IF CF="CONT" THEN GOTO 1060 

1170 NEXT I 

1180 IF NC=1 THEN INPUT"CASSETTE READY TO RECORD DATA ";NCS: 

i *** j 

NSTRUCTIONS *** 

1190 CLS:PRINT TAB( 27) "INSTRUCTIONS" 

1200 PRINT TAB(5) "IMMEDIATELY FOLLOWING THESE INSTRUCTIONS YOU WILL BE ASKED" 

1210 PRINT "TO ENTER AN I.D. CODE. THIS IDENTIFIES THE PERSON MAKING THE" 

1220 PRINT "SALE. AFTER THAT THE DISPLAY WILL BE IN THE SALE MODE WITH THE" 

1230 PRINT "OPERATIONS AND TYPES OF SALES ABBREVIATED AT THE TOP OF THE " 

1240 PRINT "SCREEN. TO ENTER AN ITEM FOR SALE FIRST PRESS THE KEY THAT " 

1250 PRINT "CORRESPONDS TO THE TYPE OF SALE, THEN KEY IN THE PRICE AND " 

1260 PRINT "PRESS 'ENTER'. ANY TIME AN ERROR IS MADE IT CAN BE CORRECTED" 

127 PRINT "BY PRESSING THE BACKSPACE KEY (ARROW POINTING TO THE LEFT) " 

1280 PRINT "BEFORE PRESSING 'ENTER'. FOR A SALE OF MORE THAN ONE OF THE SAME" 

1290 PRINT "ITEM, KEY IN THE QUANTITY BEFORE PRESSING THE TYPE OF SALE THEN 

1300 PRINT "KEY IN THE TYPE AND THE COST OF A SINGLE ITEM. THE TOTAL COST " 

1310 PRINT "WILL BE COMPUTED. WHEN ALL OF THE ITEMS HAVE BEEN ENTERED " 

1320 PRINT "PRESSING 'A' WILL CALCULATE THE TAX AND TOTAL." 

1330 PRINT TAB(30) "PRESS 'ENTER' TO CONTINUE." 

1340 D=INKEY$:IF D="" THEN GOTO 1340 

1350 ' *** SALE ENTRIES *** 

1360 ' * FIND OR CREATE EMPLOYEE SALES RECORD * 

1370 CLS:INPUT "WHAT IS YOUR THREE LETTER ID CODE ";D 

1380 FOR K=l TO 20 

1390 IF B(K)=D THEN GOTO 1420 

1400 IF B(K)="" THEN B(K)=D:GOTO 1420 

1410 NEXT K 

1420 CLS:L=64:WT=0:WS=0:K1=0 

1430 ' * TYPE OF TRANSACTION CODE HEADING * 

1440 PRINT "A=SALE TOTAL B=DAILY TOTALS CONSTRUCTIONS D=CANCEL SALE" 
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1450 FOR 1=1 TO N 

1460 PRINT 6 L,C(I) ;"=";A(I) 

1470 L=L+16 

1480 NEXT I 

1490 M=FIX(L/64)*64+64 

1500 PRINT 6 943," S 

1510 W1=0:L=943 

1520 D=INKEY? 

1530 IF D=" n THEN GOTO 1520 

1540 ■ ** SALES TRANSACTION ** 

1550 IF ASC(D)=8 THEN GOTO 1500: * BACKSPACE 

1560 IF ASC(D)>68 THEN GOTO 1690: ■ DEPARTMENTAL CODE 

1570 IF ASC(D)>=48 AND ASC1D)<=57 THEN GOTO 1640: ' ITEM MULTIPLIER 

1580 IF D="A" THEN GOTO 2030: ■ SALE TOTAL 

1590 IF D="B" THEN GOTO 2520: ' DAILY TOTAL 

1600 IF D="C" THEN GOTO 1190: ' INSTRUCTIONS 

1610 IF D="D" THEN GOTO 2480: 'CANCEL SALE 

1620 GOTO 1520 

1630 ■ * ITEM MULTIPLIER ROUTINE * 

1640 PRINT g L,D 

1650 W1=W1*10+VAL(D) 

1660 L=L+1 

1670 GOTO 1520 

1680 ■ ** DEPARTMENTAL SALE ROUTINE ** 

1690 PRINT e 948, D 

1700 L=951:W=0:U=10:V=l:I=ASC(D)-66 

1710 IF I<=20 THEN GOTO 1740ELSE PRINT 9 896, "ERROR IN DEPT. CODE" 

1720 D=INKEYS:IF D=" THEN GOTO 1720 

1730 PRINT 8 896, STRINGS (20, 32) :GOTO 1500 

1740 D=INKEYS 

1750 IF D-" THEN GOTO 1740 

1760 IF ASC(D)=13 THEN PRINT 8 943," ":GOTO 1920: ■ 'ENTER ITEM(S) 

1770 IF ASC(D)=8 THEN GOTO 1500:' REDO ITEM(S) 

1780 IF D="D" THEN GOTO 2480: "CANCEL SALE 

1790 ' ♦ ENTRY OF SALE ITEM(S) * 

1800 PRINT 9 L,D 

1810 L=L+1 

1820 IF D-"." THEN U=l:V=.l:GOTO 17 40 

1830 IF V>=.01 THEN GOTO 1890: ' INPUT ERROR ROUTINE 

1840 PRINT @ 896, "ERROR IN INPUT VALUE, PRESS BACKSPACE TO REDO" 

1850 D=INKEYS:IF D="" THEN GOTO 1850 

1860 IF ASC(D)<>8 THEN GOTO 1850 

1870 PRINT 6 896,STRINGS(44," ") 

1880 GOTO 1500 

1890 W=W*U+VAL(D)*V:V=V*V 

1900 GOTO 1740 

1910 ' * DISPLAY AND ADDITION OF SALE ITEM(S) * 

1920 IF W1=0 THEN Wl=l 

1930 W=W*W1 

1940 PRINT g M, USING E+" "+A(I);W 

1950 IF LQ=1 THEN LPRINT USING E+" "+A(I);W 

1960 WT=WT+J(I)*W: ' SALE TOTAL OF TAXABLE ITEMS 

1970 WS=WS-(J(I)-1)*W: ' SALE TOTAL OF NON-TAXABLE ITEMS 

1980 P(K1,1)=I: P(K1,2)=W ' DEPARTMENTAL RUNNING TOTAL 

1990 M=M+32:K1=K1+1 

2000 IF M>=1023 THEN M=M-64 

2010 GOTO 1500 

2020 ' * DISPLAY OF SALE TOTALS * 

2030 PRINT g 948," " 

2040 PRINT 6 M," ": PRINT USING E+" NON-TAXABLE SUBTOTAL" ;WS 

2050 IF LQ=1 THEN LPRINT USING E+" NON-TAXABLE SUBTOTAL" ;WS 

2060 PRINT USING E+" TAXABLE SUBTOTAL" ,-WT 

2070 IF LQ=1 THEN LPRINT USING E+" TAXABLE SUBTOTAL" ;WT 

2080 WV=FIX(100*T*WT+.5)/100 

2090 PRINT USING E+" TAX";WV 

2100 IF LQ=1 THEN LPRINT USING E+" TAX";WV 

2110 PRINT USING E+" TOTAL" ,-WS+WT+WV 

2120 IF LQ=1 THEN LPRINT USING E+" TOTAL" ;WS+WT+WV 

2130 INPUT "IS THIS A CHARGE SALE ";D 

2140 IF D="D" THEN GOTO 2480 

2150 IF LEFTS(D,1)="Y" AND LQ=0 THEN TC=TC+WS+WT:GOTO 2240 

2160 IF LEFT$(D,1)="Y" THEN TC=TC+WS+WT:DA="CHARGE" : LPRINT "CHARGE SALE":GOTO 22 

10:ELSE DA="CASH" 
2170 INPUT "AMOUNT RECEIVED = " ; Z 

2180 IF LQ=1 THEN LPRINT USING E+" AMOUNT RECEIVED" ;Z 
2190 PRINT USING "CHANGE DUE = "+E; Z-WS-WT-WV 

2200 IF LQ=0 GOTO 2240ELSE LPRINT USING E+" CHANGE DUE" ; Z-WS-WT-WV 
2210 LPRINT " ":LPRINT "THANK YOU, COME AGAIN SOONI ";DB 
2220 LPRINT CHR$(15) AA CHRS(14);" ";B(K); n ";KP 
2230 FOR 1=1 TO 4:LPRINT " ":NEXT I 

2240 KP=KP+1:PRINT "PUSH 'ENTER' FOR NEW SALE ";"NO. " ; KP 

2250 D=INKEYS 

2260 IF D="" THEN GOTO 2250 
2270 ZN=ZN+WS:ZT=ZT+WT 

2280 TT=TT+WV: 'RUNNING TOTAL OF SALES TAX 
2290 IF NC=0 THEN GOTO 2390 
2300 CT="":NN=1 
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2310 CR=B(K) 

2320 PRINT«-1,K,TC,TT,ZN,ZT,WS,WT,CR,KP 

2330 FOR 1=0 TO Kl-1 

2340 CT=CT+STR$(P(I,l))+";"+STR$(P(I,2))+";" 

2350 IF I=K1-1 THEN CF="DONE" ELSE CF="CONT" 

2360 IF LEN(CT)>=230 OR I=K1-1 THEN 

CR=STR$(NN)+";"+CT: 

PRINT#-1 
,CR,CF: 

CT="":NN=0 
2370 NN=NN+1 
2380 NEXT I 

2390 Y(K)=Y(K)+WS+WT: 'RUNNING TOTAL OF EMPLOYEE SALES 
2400 FOR 1=0 TO Kl-1 
2410 X(P(I,1))=P(I,2)+X(P(I,1)) 

2420 IF LQ=1 THEN LPRINT USING E+" "+A(P(I,1) ) ;P(I,2) 
2430 NEXT I 

2440 IF LQ=0 THEN GOTO 1370 
2450 LPRINT USING E+" TAX";WV 
2460 LPRINT USING E+" TOTAL" ;WS+WT+WV 
2470 LPRINT B(K);" ";DA;° ";DB;" ";KP 
2480 IF LQ=0 GOTO 1370 
2490 FOR 1=1 TO 4: LPRINT " ":NEXT I 
2500 GOTO 1370 

2510 ■ ** DAILY TOTALS ROUTINE ** 

2520 CLS:L=128:K=1:LQS="" 

2530 IF LQ=1 THEN INPUT "DO YOU WANT A PRINTED OUTPUT ",-LQS 
2540 IF LEFT$(LQS,1)="Y" THEN LP=1 ELSE LP=0 
2550 CLS:PRINT TAB120) "DEPARTMENTAL SALES" 
2560 IF LQ=1 AND LP=1 THEN LPRINT TAB(10) CHR$(15) "DEPARTMENTAL SALES" CHR5U4) 

: LPRINT " " 
2570 FOR 1=1 TO N 

2580 PRINT @ L, USING A(I)+" ="+E,-X(I) 

2590 IF LQ=1 AND LP=1 THEN LPRINT USING A(I)+" ="+E;X(I) 
2600 L=L+32 
2610 NEXT I 

2620 PRINT TAB(30) "PRESS 'ENTER' TO CONTINUE" 
2630 D=INKEYS:IF D="" THEN GOTO 2630 
2640 CLS:L=128 

2650 PRINT 8 20,"PERSONEL SALES" 
2660 IF LQ=1 AND LP=1 THEN LPRINT " ": LPRINT TABU0) CHR$(15) "PERSONEL SALES" 

CHR$(14) :LPRINT " " 
2670 PRINT § L, USING B(K)+E;Y(K) 
2680 IF LQ=1 AND LP=1 THEN LPRINT USING B(K)+E;Y(K) 

26 90 L=L+32:K=K+1 

2700 IF K=21 OR B(K)="" THEN GOTO 2710ELSE GOTO 2670 

2710 PRINT TAB(20) "PRESS ENTER TO CONTINUE" 

2720 D=INKEY$:IF D="" THEN GOTO 2720 

2730 CLS:PRINT USING "TOTAL CHARGE SALES "+E;TC 

2740 PRINT USING "TOTAL SALES TAX "+E;TT 

2750 PRINT USING "TOTAL NON-TAXABLE SALES "+E;ZN 

2760 PRINT USING "TOTAL TAXABLE SALES "+E,-ZT 

2770 PRINT USING "TOTAL SALES "+E;ZN+ZT 

27 80 PRINT "NUMBER OF SALES " ; KP 
2790 IF LQ=0 OR LP=0 GOTO 2880 

2800 LPRINT " ":LPRINT TABU4) CHR$(15) "TOTALS" CHRS (14) :LPRINT " " 

2810 LPRINT USING "TOTAL CHARGE SALES"+EjTC 

2820 LPRINT USING "TOTAL SALES TAX"+E;TT 

2860 LPRINT "NUMBER OF SALES =";KP 

2870 FOR 1=1 TO 4:LPRINT " ":NEXT I 

2880 PRINT "PRESS 'ENTER' TO CONTINUE" 

2890 D=INKEYS 

2900 IF D="" THEN GOTO 2890 

2910 GOTO 1370 

2920 CT="" 

2930 CV=MID5(CR,P,1) 

2940 IF CV=";" THEN P=P+1:RETURN 

2950 CT=CT+CV 

2960 P=P+1 

2970 GOTO 2930 
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GAMES PEOPLE PLAY 



Precision Radar Approach 

Demons 

Baseball 

Air Raid 

Ski Racer 

Petals Around The Rose 

Battleship 

Word Search 

Invisible Maze 

Super Maze 

O'Hare 

Four In A Row 

Thirteen Ways 

Siege Of Camelot 

Deduction 



John Robinson 
Mike Schelhorn 
John Rodgers 
Kevin Copeland 
Mike Zielinski 
Jim Wright 
Ty Halderman 
Len Gorney 
Dennis Nau 
James Haines 
W. MacDonald 
Mikal Pedersen 
G. Crowther 
Sanford Deutsch 
Al Leavitt 



79 



PRECISION RADAR APPROACH: by John Robinson 



Assume ILS control of the air- 
craft as it approaches a socked-in 
airport on its downwind leg. Or- 
der the pilot's turn into the pat- 
tern for base and final with an 
eye to proper alignment on the 
glide slope and glide path. He is 
approaching over a large metro- 
politan area, so rate of descent is 
critical. Five levels of difficulty 
from Tri-pacer to F4 Tomcat. A 
real white knuckle program. 




10 DEFINT i,J,K,L 

20 GOSOB 7100:PRINT6384," PAR" 

30 PRINT8512," PRECISION APPROACH RADAR" 

40 GOSUB 6500:CLS 

50 PRINT8448,"DO YOU NEED INSTRUCTIONS (Y/N) ";: INPUT YS 

60 IFLEFT?(Y$,1)="N"THEN290BLSEIFLEFT$(Y$,1)<>"Y"THEN50 

70 CLS:PRINT:PRINT" * * * INSTRUCTIONS FOR PAR * * *":PRINT 

80 PRINT"YOU WILL NOW BECOME AN 'AIR TRAFFIC CONTROLLER' VIA THE TRS80 . " 

90 PRINT'THE WEATHER HAS SUDDENLY BECOME VERY BAD:":PRINT 

100 PRINT"100 FOOT CEILING WITH VISIBILITY 1/4 MILE AND FOG.": PRINT 

110 PRINT'AS AN AIR TRAFFIC CONTROLLER, YOU MUST ISSUE INSTRUCTIONS" 

120 PRINT"TO THE PILOT VIA THE KEYBOARD, WHICH WILL ALLOW HIM" 

130 PRINT'TO LAND HIS AIRCRAFT SAFELY. " :PRINT 

134 PRINT"HIT ENTER TO CONTINUE." 

135 Y$=INKEY$:IFY$="THEN135ELSECLS 

140 PRINT'THE DISPLAY IS DIVIDED INTO TWO (2) SECTIONS. ": PRINT 

150 PRINT'THE UPPER SECTION IS USED TO CONTROL THE AIRCRAFT'S HEIGHT " 

160 PRINT"ABOVE GROUND. THE INSTRUCTIONS TO CLIMB OR DESCEND ARE ISSUED" 

170 PRINT"VIA THE UP/DOWN ARROWS ( " ;CHR$ (91 ) ,-CHRS ( 92 ) " ) . THE AIRCRAFT MUST BE IN 

LEVEL" 
180 PRINT'FLIGHT AFTER TOUCHDOWN ON THE RUNWAY. ": PRINT 

190 PRINT'THE LOWER SECTION IS USED TO CONTROL THE FLIGHT OF THE AIRCRAFT" 
192 PRINT'OVER THE SURFACE OF THE EARTH. INSTRUCTIONS TO TURN LEFT OR" 
194 PRINT'RIGHT ARE ISSUED VIA THE LEFT/RIGHT ARROWS ( " ;CHRS ( 93) ;CHR$ ( 94 ) ; ") . " 

196 PRINT'HIT ENTER TO CONTINUE." 

197 Y$=INKEYS:IFY5=""THEN197ELSECLS 

198 PRINT: PRINT'THE AIRCRAFT WILL FIRST APPEAR ON THE LOWER SECTION OF THE" 
200 PRINT"DISPLAY AND MOVE FROM LEFT TO RIGHT. AFTER THE AIRCRAFT HAS" 

202 PRINT"BEEN TURNED ON TO FINAL APPROACH TO LAND, IT WILL APPEAR IN" 

204 PRINT'THE UPPER SECTION OF THE DISPLAY AND MOVE FROM RIGHT TO LEFT." 

206 PRINT'THE AIRCRAFT ONLY APPEARS IN THE UPPER SECTION OF THE DISPLAY" 

208 PRINT'WHILE ON FINAL APPROACH .": PRINT 

210 PRINT"IF AN AIRCRAFT IS TOO HIGH TO LAND, TURN THE AIRCRAFT TO THE" 

212 PRINT'RIGHT AND PROCEED TO GO BACK FOR ANOTHER APPROACH." 

214 PRINT"DURING THE TIME THAT THE AIRCRAFT IS NOT BEGINNING DISPLAY" 

216 PRINT"IN THE UPPER SECTION, HIT THE UP ARROW TO CLIMB TO A SAFE" 

218 PRINT'ALTITUDE." 

220 PRINT'HIT ENTER TO CONTINUE." 

221 Y$=INKEY$:IFY$=""THEN221ELSECLS 

222 CLS:GOSUB 6100:GOSUB 6200 

224 PRINT664, "UPPER SECTION CONTROLLED BY UP/DOWN ARROWS (" ;CHRS ( 91 ) ;CHR$ (92) ;") " 

226 PRINTei93,"RUNWAY";:PRINT6237," BUILDINGS "; 

228 PRINT6384, "LOWER SECTION CONTROLLED BY LEFT/RIGHT ARROWS (" ;CHR$ ( 93) ;CHR? ( 94 ) 

;")"; 

230 PRINT§641,"RUNWAY";:PRINT@670, "CENTER LINE"; 

231 PRINTS64*8,TAB(20)"< (DIRECTION TO LAND IN)"; 

232 PRINTS896,"HIT ENTER TO CONTINUE. " :DM=-1 

233 Y$=INKEY$:IFY$=""THEN233ELSECLS 
290 GOSUB 7200 

300 GOSUB 6100 : GOSUB 6200 

490 RY=0:Y=3:X=127:SET(127,3) :LG=0 

500 X2=2:Y2=19:RT=90:XT=1:YT=0:SET(X2,Y2) 

505 X1=X2:Y1=Y2 

510 IF DM THEN A$ = " ELSE A$ = INKEYS 
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511 IF NOT DM THEN 515 

512 D0=D0-1:IF D0>0 THEN 515 ELSE READ D0 ,A:A$=CHR$ (A) 

513 IF A=9 THEN A=94 ELSE IF A=10 THEN A=92 ELSE IF A=8 THEN A=93 

514 PRINT@64*15+PS,CHR$(A) ; : PS=PS+2 

515 IF RT>360 THEN RT=RT-360 

520 IF AS=CHR$(9) THEN RT=RT-15*TR: GOSUB 6300:GOTO 540 

530 IF AS=CHR$(8) THEN RT=RT+15*TR:GOStJB 6300 

540 X2=X2+XT:Y2=Y2+YT 

550 GOSUB 6000:X1=X2:Y1=Y2:GOSUB 6400:GOSUB 6000 

560 IF Y2<29 OR Y2>38 AND X2>109 THEN 1100 

1010 X1=X:Y1=Y 

1030 IF A$=CHRS(91) THEN RY=RY-.15*CR 

1040 IF A$=CHRS(10) THEN RY=RY+.15*CR 

1050 GOSUB 6000:X1=X2:X=X2:Y=Y+RY:Y1=Y:GOSUB 6600:GOSUB 6000 

1080 GOTO 505 

1100 IF ASOCHRS191) THEN 505 

1110 Xl=X:Yl=Y:GOSUB 6000 

1120 X=127:Y=3:SET(X,Y) 

1130 LG=0:RY=0:GOTO 505 

5000 END 

6000 REM TEST AND SET 

6010 IF P0INT(X1,Y1) THEN RESET(X1,Y1) ELSE SET(X1,Y1) 

6020 RETURN 

6100 REM GRAPHICS FOR GLIDESLOPE 

6110 FOR I = 2 TO 29 : SET(I,14) : NEXT I 

6120 FOR I = 32 TO 127 : SET(I,14) 

6130 IF I < 47 THEN 6170 

6145 IF I => 97 THEN K=RND(7) : GOTO 6160 

6150 K = (RND(I-47))*.12 

6160 FOR L = 13-K TO 13 : SET(I,L) : NEXT L 

6170 NEXT I 

6180 RETURN 

6200 REM GRAPHICS FOR RUNWAY 

6210 FOR I = 2 TO 29 

6220 FOR J = 33 TO 35 

6230 SET(I,J) 

6240 NEXT J, I 

6250 FOR I = 32 TO 122 STEP 10 : SET(I,34) : NEXT I 

6260 RETURN 

6300 REM CALCULATE TURN RATES 

6310 XT=SIN(RT*.0174533)*SP 

6320 YT=(COS(RT*.0174533)*SP)/2 

633 RETURN 

6400 REM CHECK X-Y CO-ORDINATES 

6405 IF LG<LC AND X2<2 AND INT(Y)=13 THEN 7030 

6410 IF X2>127 OR X2<0 THEN 6440 

6420 IF Y2>47 OR Y2<16 THEN 6440 

6430 RETURN 

6440 GOSUB 7100 

6450 PRINT8256," RADAR CONTACT LOST" 

6460 PRINT8384," AIRCRAFT OUT OF RANGE" 

6470 GOSUB 6500 

6480 DM=0:CLS:PRINT@448,"";:INPUT"WOULD YOU LIKE TO TRY AGAIN {Y/N)";Y$ 

6490 IFLEFT$(Y$,1)="Y"THEN290ELSEIFLEFT$(Y$,1)="N"THENSTOPELSEGOTO6480 

6495 STOP 

6500 REM TIME DELAY ROUTINE 

6510 FOR I = 1 TO 3000 : NEXT I : RETURN 

6600 REM CHECK FOR Y C0-0RDINATE - GLIDESLOPE 

6610 IF Y=>0 THEN 6660 

6620 GOSUB 7100 

6630 PRINTS256," AIRCRAFT TOO HIGH"; 

6640 PRINT8384," CANNOT INTERCEPT GLIDESLOPE" 

6650 GOTO 6470 

6660 IF POINT(X,Y) THEN 6670 ELSE 6705 

6670 IF X<48 THEN 6710 

6680 GOSUB 7100 

6690 PRINTS448," CRASHlil" 

6700 GOTO 6470 

6705 IF X>47 THEN RETURN 

6710 IF X>29 AND Y=>13 THEN 6800 

6720 IF X>1 AND Y=>13 THEN 6860 

6730 IF X<=1 AND Y<13 THEN RETURN 

67 90 RETURN 

6800 IF Y2=>36 OR Y2<33 THEN 6680 

6810 GOSUB 7100 

6820 PRINT6256, "EXCELLENT APPROACH EXCEPT" 

6830 PRINT8384, "AIRCRAFT MADE A CRASH LANDING" 

6840 PRINT8512," SHORT OF THE RUNWAY" 

6850 GOTO 6470 

6860 IF Y2=>36 OR Y2<33 THEN 6970 

6870 IF POINT(X,Y) THEN 6925 

6880 LG=LG+1:IF LG<LC THEN RETURN 

6890 GOSUB 7100 

6900 PRINTS448," .PERFECT APPROACH" 

6910 PRINTS576," PERFECT LANDING" 

6920 GOTO 6470 
6925 GOSUB 7100 
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6930 PRINTB448, "PERFECT APPROACH EXCEPT" 

6940 PRINT§576,"THE PILOT BORED A HOLE" 

6950 PRINT9704," IN THE RUNWAY" 

6960 GOTO 6470 

6970 IF Y<13 THEN RETURN 

6980 GOSUB 7100 

6990 PRINTH20, "PERFECT APPROACH EXCEPT" 

7000 PRINT6448,"THE AIRCRAFT HISSED THE RUNWAY" 

7010 PRINT8576," AND CRASHED" 

7020 GOTO 6470 
7030 GOSUB 7100 

7040 PRINT8320, "PERFECT APPROACH EXCEPT" 

7050 PRINT8448,"THE AIRCRAFT RAN OFF THE END" 
7060 PRINT8576," OF THE RUNWAY" 
7070 PRINT8704," AND CRASHED" 
7080 GOTO 6470 
7090 RETURN 

7100 REM CLEAR AND CHAR SIZE 
7110 CLS:PRINT CHRS (23) : RETURN 
7200 REM LEVEL OF PLAY 

7210 IF DM THEN L=l :CLS: PRINT"FOLLOWING IS A DEMONSTRATION OF A SAMPLE LANDING P 
ATTERNI" ELSE CLS: PRINT: INPUT'SELECT LEVEL OF PLAY (1 THRU 5) " ;Y?:L=VAL(Y$) 
7220 IF L<1 OR L>5 THEN 7210 
7230 PRINT:ON L-l GOTO 7280,7330,7380,7430 
7235 CR=1:SP=1:TR=2:LC=8 
7240 PRINT"LEVEL 1": PRINT 

7250 PRINT"A PIPER TRI-PACER WILL ENTER ON A RIGHT DOWN WIND LEG": PRINT 
7255 PRINT"THIS WILL BE EASY" 

7260 PRINT:IF DM THEN PRINT "HIT 'ENTER' WHEN READY TO WATCH DEMONSTRATION." ELS 
E PRINT"HIT 'ENTER' WHEN READY TO TAKE CONTROL." 

7261 Y$=INKEY$:IFY$=""THEN7261 

7265 CLS:IF DM PRINTS64*15 ,"KEYS HIT: ";:PS=POS(0) 

7270 RETURN 

7280 CR=2:SP=2:TR=3:LC=8 

7290 PRINT"LEVEL 2":PRINT 

7300 PRINT"A TIWN CESSNA 421 WILL ENTER ON A RIGHT DOWN WIND LEG":PRINT 

7310 PRINT"THIS COULD BE A DIFFICULT APPROACH" 

7320 GOTO 7260 

7330 CR=3:SP=3:TR=3:LC=8 

7340 PRINT"LEVEL 3":PRINT 

7350 PRINT"A BOEING 727 WILL ENTER ON A DOWN WIND LEG":PRINT 

7360 PRINT"GET READY, THIS IS GOING TO BE TOUGH" 

7370 GOTO 7260 

7380 CR=4:SP=4:TR=3:LC=7 

7390 PRINT'LEVEL 4":PRINT 

7400 PRINT"A FAST MOVING F14 TOMCAT WILL BE NEXT FOR AN APPROACH" : PRINT 

7410 PRINT'ONLY THE BEST WILL BE ABLE TO VECTOR THIS AIRCRAFT FOR" 

7412 PRINT"AN APPROACH GOOD LUCK, THE PILOT WILL NEED IT" 

7420 GOTO 7260 
7430 GOSUB 7100 

7 440 PRINT§448 , " UFOl ! 1 il " 

7450 CR=RND(6) :TR=RND(6) :SP=RND(20) :LC=INT(28/SP) 

7460 IF INT(RND(3))<>2 THEN 7480 

7470 CR=CR*-1 

7480 IF INT(RND(3))<>2 THEN 7500 

7 490 TR=TR*-1 

7500 GOSUB 6500:CLS 

7510 RETURN 

8000 DATA 80,0,20,9,8,9,8,9,4,9,4,9,4,9,42,0,1,10,2,10,2,10,19,0,2,91,1,91,1,91, 

30,0 
9000 END 
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DEMONS: by Mike Schelhorn 



Choose one of fourteen char- 
acters according to your prefer- 
ence for their relative strengths 
and weaknesses in the areas of 
magic, charisma, combat skill, 
etc. Make your move and let the 
game begin. 




"LIGHTNING" :HA 



it 



#####*St# 



10 DEFINTA-Z:CLEAR(550) : DIM MS (14) :RANDOM:T$ (0)="SWORD":TS (1)="LYRE" sTS (2) ="BATT 
LEAX":T$(3)="AMULET":TS(4)="SHIELD":T$(5)="RING":TS(6)="PENDENT":T$(7)="CRO 

SS" :TS ( 8) ="STAFF" :T$ (9) ="FLASK" 
15 MAS(2)="SPEARBOLT":MAS(3)="FIREBLAST":MAS(4)="FIREBALL":MA$(5)= 

S(7)="SCREEN" 
30 CLS: PRINT"* NAME CLEVERNESS CHARISMA MAGIC COMBAT STRENGTH TALISMAN" :FO 

RA=1T014:READCS,I,C,M,F,H,T:PRINTA;" ";C$;TAB(16) I;TAB(26!C;TAB(34)M;TAB(4 

1>F;TAB(48)H;TAB(55)T?(T) :NEXT: INPUT"WHICH CHARACTER DO YOU CHOOSE" f B:CLS: I 

FB=0GOTO50 
40 RESTORE: FORA=lTOB:READCS , I, C,M,F,H,T:NEXT: H1=H:M1=M:T(T) =1 : IFB/2=INT(B/2) THEN 

G=0:GOTO190:ELSEG=1:GOTO190 
50 INPUT"NAME" ; C$ : INPUT'CLEVERNESS" ,- I : INPUT"CHARISMA" ;C : INPUT"STRENGTH" ; H : INPUT" 

MAGIC " ; M: INPUT"COMBAT" ,- F : H1=H : M1=M: INPUT'GENDER" ; AS : IFLEFT$ (AS , 1) ="M"THENG= 

0ELSEG=1 
60 PRINT"TALISMANS":FORT=0TO9:PRINTT+1;" " ;TS (T) :NEXT: INPUT"WHICH TALISMAN DO Y 

OU WANT";A:T(A-1)=1 
190 MS<0)="[[lUU![ [[[[[([l[(l[[#*t»##"=MS(l)="UU[l[[n [[UIUjljjUHtS 

f#":MS(2)="[[(l[[[|$S?S[[([HU[ »##tt***":MS(3)="t t II I+[[SSSSSlt [ I t 

l#*M#»":M$(4)="[ [[[[[$$$$[[[ Ul «##•+»#«#" 
200 MS(5)="m[[[UU[[[[[[ *###»»«# ":M$(6)="([[[lIll[U 

S":MS(7)="[[[[I[[[[IIt + #»«#»»#» SS1:MS(8)="[[[[[[[U[ 

S SSSS":MS(9)="[[[[[H[[[ #«###»# SSSSS" 
210 MS(10)="!U+[t![ [[[t#»»#t#l $S$SSS":M$(ll)="[[[[ll [[[[####«##*# SSSS 

+$?S":M$(12)-"U [[[[[««#«»»» SS$$SSSS":MS(13)=" [[[[[[###*#»#*## 
?$S$SS$5":MS(14)="(ll[( I [ [####*«#### SSSSSSSSS" 

220 GOSUB700:FORA=1TO3 

230 X=RND(15)-l:Z=RND(31):AS="?":IFMID?(MS(X),Z.l)=""?"THEN230ELSEGgSUB970:NEXT 

240 X=RND(15)-1:Z=RND(31):IFMID$(MS(X),Z,!)=^"THEN240ELSEA?="H":B5=AS:GOSUB970: 

D— 1 • XI ^X" Zl=Z 
350 CLS:PRINt'cHRS(23):FORA=0TO14:PRINTMS(A):NEXT:PRINT"DAY #";D; : INPUT"ENTER YO 

UR MOVE" ;B:A?=BS:GOSUB970:CLS:ONB+1GOTO360, 400, 410, 420, 430, 440, 450, 460, 47 
355 GOSUB700:AS="*":GOSUB970:GOTO350 
360 CLS:INPUT"DO YOU WISH TO REBUILD YOUR MAGIC OR STRENGTH" ;DS : IFLEFTS (DS,D = M 

"THEN380 
370 IF H1=H PRINT"YOU ARE ALREADY AT MAXIMUM STRENGTH" :GOTO990 
372 IFT(9)=1PRINT"A DRINK FROM YOUR MAGIC FLASK HEALS ALL YOUR WOUNDS" :S=1:H1=H : 

GOTO990 
375 H1=H1+2:IFH1>HTHENH1=H:S=3:GOTO990ELSE990 

380 IF M1=M PRINT"YOU ARE ALREADY AT MAXIMUM MAGIC LEVEL" :GOTO990 
390 M1=M1+3:IFM1>MTHENM1=M:S=2:GOTO990ELSE990 
400 Z1=Z+1:GOTO480 
410 Z1=Z+1:X1=X-1:GOTO480 
420 X1=X-1:GOTO480 
430 Z1=Z-1:X1=X-1:GOTO480 
440 Z1=Z-1:GOTO480 
450 Z1=Z-1:X1=X+1:GOTO480 
460 X1=X+1:GOTO480 
470 Z1=Z+1:X1=X+1 

480 IF XK0ORX1>14ORZK1ORZ1>31THEN490ELSE500 
490 PRINT"YOU MADE AN INCORRECT MOVE ,TRY AGAIN" :GOTO990 
500 X=X1:Z=Z1:BS=MIDS(MS(X),Z,1):A$="*":GOSUB970:IFBS=" " :S=1:GOTO550 
510 IF B$="+"S=1:GOSUB1000:GOSUB940:GOTO580 
520 IF BS="["S=2:GOTO550 
530 IFB?="#"S=3:GOTO550 
540 IFBS="S"S=4:GOTO550 

545 IFB$="?"THENBS=" " :S=5 :GOSUB1000 :GOSUB940 :GOTO2400 
547 IFB$="H"GOTO3010 

550 IFI+S<5+RND(3)-2ANDRND(5)=1CLS:GOSUB1000:GOSUB940 
555 Xl=X:Zl=Z:S=INT(S*6/Hl+.4)-N:D=D+S:IFD+D2>150+DlGOTO2990 
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560 ONRND( 5) G0TO35 0,350, 35 0,350, 2000 

570 GOSUB940:GOTO35 

580 CLS:INPUT"DO YOU WISH TO TELEPORT" ;D$: IF DS="NO"555 

590 IF X=3THENP=1:GOTO620 

595 IF X=4THENP=2:GOTO620 

600 IF X=7THENP=3:GOTO620 

610 IF X=10THENP=4ELSEP=5 

620 A$=B$:GOSUB970:A$="*":IF Ml<3 THEN PRINT"YOU ONLY HAVE ";M1; "MAGIC POINTS TH 

E PORTAL IS BEGINNING TO WORK ,YOU GET RANDOMIZED TO A DIFFERENT DESTINATIO 

N":GOSUB940:GOTO640 
630 S=S+3:PRINT"HERE IS A DISPLAY OF THE WAY THE PORTALS ARE LAID OUT :":PRINT"1 

+ 2+":PRINT" 3t":PRINT"4+ 5+":PRINT"YOU ARE AT ";P; : INPUT"WHICH ONE DO Y 

OU WISH TO TRAVEL TO" ; A:Ml=Ml-3 :ON A GOTO 650,660,670,680,690 
640 A=RND(5) :IFP=AGOTO640ELSEONAGOTO650, 660 ,670 ,680,690 
650 X=3:Z=6:GOSUB970:GOTO555 
660 X=4:Z=26:GOSUB970:GOTO555 
670 X=7:Z=18:GOSUB970:GOTO555 
680 X=10:Z=4:GOSUB970:GOTO555 
690 X=11:Z=28:GOSUB970:GOTO555 
700 CLS:PRINT"TREASURE",TR:PRINT"DAY #",D: PRINT"DAYS TO GO" , 150-D+D1-D2: PRINT"NA 

ME",C$:PRINT"O.EVERNESS",I:PRINT"CHARISMA",C:FRINT"COMBAT",F:PRINT"TOTAL ST 

RENGTH",H:IFH1>HTHENH1=H 
710 PRINT"STRENGTB",Hl:PRINT"WOUNDS",H-Hl:PRINT"TOTAL MAGIC " ,H : PRINT"PRESENT MAG 

IC",M1:PRINT"MAGIC USED" ,M-M1 : PRINT"TALISMANS" ; : FORA=0TO9 : IFT( A) =1PRINT,T$ ( 

A) , 
720 NEXT:GOSUB940:RETURN 
800 FORR=90TO103:FORY=3TO8:SET(R,Y) :NEXTY,R:FORR=79T0116 :F0RY=11T026 :SET(R,Y) :NE 

XTY,R:FORY=27TO29:FORR=86TO109:SET(R,Y| :NEXTR, Y: P=ll : FORY=30TO44STEP2 : P=P-1 

:FORR=0TOP:SET(R+86,Y) :SET(R+86,Y+1) :SET(109-R,Y) :SET(109-R,Y+1) :NEXTR,Y 
810 FORR=76T089:F0RY=46TO47:SET(R,Y) :SET(30+R,Y) :NEXTY,R:FORR=92TO101 :SET(R, 9) :N 

EXT:FORR=93TO100:SET(R,10) :NEXT: FORR=75TO80 :FORY=25T026 :SET(R,Y) :SET(R+39,Y 

) :NEXTY,R:FORR=84T085:FORY=15T026:RESET(R,Y) : RESET (R+ 26 ,Y) :NEXTY,R 
820 RESET(90,3):RESET(103,3):RESET(97,6) :FORR=94T099:RESET(R,8) :NEXTR:RESET(93, 4 

) :RESET(94,4):RESET{100,4) :RESET(99,4) :FORY=4T06 :SET(89,Y) : SET (104, Y) :NEXT: 

FORY=3T05:SET(88,Y) :SET(105,Y) :NEXT 
830 IFL=9ORL=10ORL=12THENFORY=0TO2:SET(93,Y) :SET(100,Y) :NEXT 
840 IFL=9ORL=10ORL=17ORL=18THENFORY=3TO36:SET(76,Y) :SET(75,Y) :NEXT 
850 IFL=9ORL=10THENFORY=3TO8:SET(71,Y) :SET(B0,Y) :NEXT:FORR=71TO80 :SET(R, 9) :NEXT 
860 IFL=15THENFORY=9T028:SET(76,Y) :NEXT 
870 IFL=11THENF0RY=27T028:SET(75,Y) :SET(77,Y) :SET(79,Y) :SET(115,Y) :SET(117,Y) :SE 

T(119,Y) :NEXT:FORY=2T04:SET(88,Y) :SET(89,Y) :SET(104,Y) :SET(105,Y) :NEXT 
880 IFL=18THENP=-1:FORY=24TO46STEP2:P=P+1:FORR=86-PTO109+P:SET(R,Y) :SET(R,Y+1) -N 

EXTR,Y:FORY=6T09:SET(88,Y) :SET(105,Y) :NEXT:FORR=88TO105 :SET(R,3) :NEXT 
890 IFL=16THENFORR=40TO70:FORY=25TO27:SET(R,Y) :NEXTY, R: FORR=71T074 :SET(R,26 ) :NEX 

T 
900 IFL=13THENFORR=70TO120:FORY=2TO47:IFPOINT(R,Y) RESET (R,Y) :NEXTY,R: ELSESETIR.Y 

) :NEXTY,R 
930 GOSUB940:CLS: RETURN 
940 FOR A=1TO2500:NEXT:RETURN 
950 DATA NOBLEMAN, 2, 2, 6, 7, 7,0, PRINCESS, 2, 3, 8, 5, 5, 6, WIZARD, 2, 2, 10, 4, 6, 8, ENCHANTRE 

SS,2,3,10,4,5,8,WARRIER,1,1,5,10,8,4,AHAZON,1,1,5,10,8,2,WOODCUTER,1,2,5,8, 

10, 9, SHEPHERDESS, 1,3, 5, 8, 10, 3, TROUBADOUR, 2, 4, 6, 5, 5,1, SONGSTRESS, 2, 4, 6, 5, 5,1 
960 DATAJESTBR, 3 ,3,7,5,4, 5, HUNTRESS, 2, 2, 6, 7, 7, 3, SCHOLAR, 3, 2, 8, 4, 4, 7, PRIESTESS, 3, 

3,7,4,5,7 
970 E=31-Z:M1$=MID$(M$(X),1,Z-1):M2$=MID?(M$(X),Z+1,E):M$(X)=M1$+A$+M2$:RETURN 
990 A$="*":GOSUB940:GOSUB970:GOTO550 
1000 S1=0:H3=0:EM=0:M2=0:I1=4:T1=0:L=RMD(28) :ONLGOTO1010, 1020, 1040, 1060, 107 0,108 

0,1090,1100,1110,1120,1130,1140,1150,1200,1210,1220,1230,1240,1300,1310,132 

0,1330,1340,1360,1370,1380,1390,1400 
1010 A=RND(10)-1:IFT(A)=1PRINT"YOU LOSE YOUR " ,-TS (A) :T( A) =0:RETURN 
1020 PRINT"YOU ACCIDENTLY STUMBLE UPON A VORTEX OF EVIL" : IFT(7 ) =1PRINT"Y0UR HOLY 
";TS(7);" DESTROYS IT" rRETURNELSE IFT(6 ) =1PRINT"Y0UR MAGIC ";T$(6);" DESTR 

OYS IT": RETURN 
1025 IF Ml>=4PRINT"YOU SPEND 4 MAGIC POINTS FIGHTING IT. " :Ml=Ml-4 :RETURN 
1030 PRINT"IT IS TOO MUCH FOR YOU AND YOU DIE" :GOTO3000 
1040 PRINT'YOU ARE ATTACKED BY A SWARM OF KILLER ANTS" : IF Hl>=5PRINT"YOU RECIEVE 

4 WOUNDS IN THE FIGHT THAT ENSUES" :Hl=Hl-4 :RETURN 
1050 PRINT'YOU ARE CRITICALLY WOUNDED AND DIE" :GOTO3000 
1060 IFT(3)=0ORS<>5 PRINT"RATS EAT SOME OF YOUR FOOD. " : PRINT'YOU HAVE 12 LESS DA 

YS TO COMPLETE YOUR QUEST. " :D2=D2+12 : RETURN 
1070 IFSO50RB$="+"PRINT"Y0U STUMBLE INTO A TELEPORTATION VORTEX" : PRINT'YOU ARE 

TELEPORTED TO ANOTHER PLACE" :GOSUB940 :AS=BS :GOSUB970 :A$="*" :X=RND (15) -1: Z=R 

ND(31) : BS=MIDS(MS(X) ,Z,1) :GOSUB970:X1=X:Z1=Z:RETURNELSE1000 
1080 IFSO5PRINT"Y0U ENTER AN EVIL AREA WHICH TAKES TWELVE DAYS TO TRAVERSE" : S=l 

2: RETURN 
1090 IFSO5ANDRND(2)=lPRINT"Y0U LOSE ALL YOUR TREASURE" :TR=0 :RETURNELSE1000 
1100 C1$="GLORB":F2=8:H2=6:H3=1:M2=10:T1=500:GOTO1250 
1110 C1$="DEVIL":F2=9:H2=9:H3=1:S1=2:GOTO1160 
1120 C1S="DEMON":F2=8:H2=7:H3=1:S1=2:GOTO1160 
1130 C1?="WEREWOLF":F2=8:H2=8:S1=1:GOTO1160 
1140 CI S= "GARGOYLE" :F2=7 : 11=3 :H2=7 :T1=100:GOTO1160 
1150 C1S="WRAITH":F2=6:I1=3:H2=4:H3=J.:S1=1:T1=200:M2=8:GOTO1160 
1160 PRINT"YOU ENCOUNTER A " ;C1$ :GOSUB800 : IFT(7 ) =1PRINT"Y0UR HOLY ";TS(7); n FRIG 

HTENS HIM AWAY":RETURN:ELSEGOTO1450 
1200 C15="BANDIT":I1=2:F2=6:M2=6:H2=6:T1=100:GOTO1250 
1210 C1S="EVIL WARRIER":I1=2:F2=10:M2=4:H2=8:T1=50:GOTO1250 
1220 C1$="GIANT": 11=3 :F2=8:M2=4:H2=14:T1=100:GOTO1 250 
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1230 C1$="WARLOCK":I1=3:F2=4:H2=5:M2=12:T1=50:GOTO1250 

1240 C1$="WITCH" :I1=3 : F2=4 :H2=4 :M2=12 :T1=50 :GOTO1250 

1250 PRINT-YOU MEET A ";C1?:GOSUB800:GOTO1450 

1300 C1$="WILDMAN":I1=2:F2=6:H2=6:T1=25:GOTO1350 

1310 C1$="WOLF":F2=5:H2=5:GOTO1350 

1320 C1?="BEAR":I1=3:F2=8:H2=10:GOTO1350 

1330 C1$="SNAKE":I1=2:F2=4:H2=4:GOTO1350 

1340 C1$="LI0N":I1=3:F2=7:H2=7: 

1350 PRINT"YOU COME FACE TO FACE WITH A " ;C1S : IFT(3) =1THEN PRINT"YOUR ";TS(3);" 

FRIGHTENS IT AWAY" :RETURNELSE14 50 
1360 C1$="GRIFFON":F2=8:H2=8:T1=50:S1=1:GOTO1410 
1370 C1$="DRAGON":F2=9:H2=9:S1=2:T1=1000:GOTO1410 
1380 C1$="CENTAUR":F2=6:H2=8:I1=3:M2=6:T1=50:GOTO1410 
1390 C1$="TROLL":F2=6:H2=9:H3=1:I1=2:T1=100:GOTO1410 
1400 C1$="GOBLIN":T1=200:F2=7:H2=7:M2=4:I1=2 
1410 PRINT'YOU MEET A ";C1S 
1450 IFI1+RND(3)-2<C+T(1)PRINT"Y0UR GREAT SINGING LULLS THE ";C1$;" TO SLEEP":RE 

TURN 
1460 PRINT"THE ";«$(" IS IN A NASTY MOOD" 
1470 PRINT"YOU MAY ATTEMPT TO FLEE. WHETHER YOU SUCCEED OR NOT YOU RECIEVE ONE W 

OUND":INPUT"DO YOU TRY TO FLEE" ;D$ : IFLEFT5 (D$,l) ="N"THEN1500 
1480 IFH1>H2+RND(5)-3PRINT"Y0U LEAVE THE ";C1$,-" BEHIND BUT RECIEVE ONE WOUND":H 

1=H1-1:GOSUB940:A$=B$:GOSUB970:ONRND(8)GOTO400,410,420,430,440,450,460,470 
1490 Hl=Hl-l:PRINT"YOU ARE UNSUCCESFUL AND RECIEVE ONE WOUND" 
1498 REM*COMPUTER MOVE 
1500 A=0:YM=0:EM=0:J=0:K=0:Q=0:PRINTCS;" MAGIC=";M1,C1S; " MAGIC=";M2: PRINTCS; " S 

TRENGTH=";H1,C1$;" STRENGTH=";H2:IFM2=0THENIFS1=2THENEM=3: J=1:GOTO1560BLSE1 

560 
1510 EM=RND(8) : IFEM=8ANDM2>5THBNM2=M2-6:EM=0: :H2=H2+H2: J=0:GOTO1560 
1520 IFEM=7ANDM2>2THENM2=M2-3:J=2:GOTO1560 
1530 IFEM=6ANDM2>2THENM2=M2-3:J=2:H2=H2+2:EM=0:GOTO1560 
1540 IFEM=1THENM2=M2~EM:J=-2:GOTO1560 
1550 IFM2-EM>=0THENM2=M2-EM:J=2ELSEEM=0 
1560 REM*BEGIN HUMAH MOVE 

1570 IFT(5)=1INPUT"D0 YOU FIRE A BLAST WITH YOUR RING" ;D$ELSE1590 
1580 IFLEFTS<DS,1)O"N"THENYM=3:K=2:GOTO1700 

1590 IFM1>0INPUT"DO YOU USE MAGIC",-D$ : ELSEFORY=1TO500 :NEXT:GOTO1700 
1600 IFLEFT${D$,1)="N"THEN1700 
1610 CLS:PRINT"# SPELL", "COST", "EFFECTS" :PRINT"1 APPARITION" , "1" , "+2 COMBAT":P 

RINT"2 ";MAS(2) ,"2","-l STRENGTH ENEMY " :PRINT"3 " ;MA$ (3) , "3" , "-2 STRENGTH 
ENEMY":PRINT"4 ";MA$ (4) , "4", "-3 STRENGTH ENEMY" :PRINT"5 " ;MAS (5) , "5" , "-4 
STRENGTH ENEMY" 
1620 PRINT"6 STRENGTH", "3", "+2 YOUR STRENGTH" :PRINT"7 " ;MA$ (7) , "3" , "DEFLECTS E 

NEMY MAGIC": PRINT" 8 SUPER POWER" , "6 ", "DOUBLES STRENGTH" : PRINT"9 TELEPATHY 

","l","KNOW ENEMY MOVE" : PRINT"10 MAGIC BLADE" , "3" , "HURTS '2' CREATURES" 
1630 INPUT'WHICH SPELL DO YOU CHOOSE" ;YM :CLS: IFYM=8ANDM1>5THENM1=M1~6 : YM=0: H1=H1 

+H1:K=2:GOTO1700 
1635 IFYM=10ANDM1>2ANDS1=1THENM1=M1-3:K=2:S1=0:GOTO1700 
1640 IFYMO9THEN1660ELSEK1=M1-1:YM=0:K=1:PRINT"THE ";C1$;" CHOOSES 
1650 IFEM>0PRINT"MAGIC SPELL f " ;EM:GOTO1560ELSEPRINT"COMBAT" :GOTO1560 
1660 IFYM=7ANDM1>2THENM1=M1-3:K=2:GOTO1700 
1670 IFYM=6ANDM1>2THENM1=M1-3:K=2:YM=0:H1=H1+2:GOTO17 00 
1680 IFYM=1THENK=-2:YM=0:M1=M1-1:GOTO1700 

16 90 IFM1-YM>=0ANDYMO9THENM1=M1-YM : K=2 :GOT017 00 

1695 YM=0:PRINT"YOU DON'T HAVE ENOUGH MAGIC FOR THAT SPELL" :GOTO1590 

1700 IFJ>0ANDK>0THEN1800 

1705 IFS1=2ANDT(0)=0ANDT(2)=0ANDK=0THENPRINT"ONLY MAGIC OR THE SWORD OR BATTLEAX 

E CAN KILL THE ";ClS:K=K+4 
1710 FH=F+INT(Hl/3+I)+2*T(0)-K:FE=F2+INT(H2/2)-J:PRINT"FH=";FH,"FE=";FE:B=RND(5) 

:IFFE>=FH+3THENONBGOTO1750, 1750, 1760, 1760, 17 90 
1720 IFFE>FHTHENONBGOTO17 90,17 90,1750,17 50,1760 
1730 IFFE=FHTHENONBGOTO1750 , 17 80,1800,1800 , 17 90 
1740 IFFH>=FE+3THENONBGOTO1770 , 17 90 , 17 80 , 17 80 , 1770ELSEONBGOTO17 90 , 17 90 , 17 80 , 17 80 

,1770 
1750 A=l-T(4) :GOT017 95 
1760 A=2-T(4):GOT017 95 
1770 Q=2:GOT01795 

17 80 Q=1:G0T01795 
1790 Q=1:A=1-T(4) 

1795 IFT(2)=1PRINT"Y0UR ";T5(2);" SCORES ONE HIT":Q=Q+1 

1800 IFEM>1ANDEM<6THEN1810ELSE1825 

1810 IFYM=7ANDEM<6ANDEM>1PRINT"Y0UR MAGIC SCREEN DEFLECTS ";C1S;" MAGIC ";MAS(EM 

) :GOTO1850ELSEIFT(6)=1ANDEM<6ANDEM>0PRINT"YOUR ";T$(6);" ABSORBS ENEMY MAGI 

C ",-MA$(EM) :GOT01825 
1820 A=A+EM-1:PRINT"THE ";C1S;" HITS YOU WITH A ";MAS(EM) 
1825 IFYM<1ORYM>5GOTO1850 

1830 IFEM=7PRINT"ENEMY MAGIC SCREEN DEFLECTS YOUR MAGIC " ; MA? (YM) :GOTO1850 
1840 PRINT"YOUR ";MA?(YM);" HIT THE " ;C15 :Q=Q+YM-1 
1850 H1=H1-A:H2=H2-Q:PRINT"Y0U RECIEVED ";A;" WOUNDS AND THE ";C1$;" RECIEVED " ; 

Q:IFHK=0PRINT"THE ";C1$;" KILLS YOU" :GOTO3000 
1870 IFH2<=0PRINT"YOU KILL THE " ;C15:TR=TR+T1 :GOSUB940 :GOSUB700 :RETURN 
1880 IFT(8)=1ANDMKMPRINT"Y0UR MAGIC ";T$(8);" REGENERATES 1 MAGIC POINT" -M1=M1 + 

1 
1890 H2=H2+H3:IFH2<3ANDRND(3)=1PRINT"THE ";C1$;" RUNS AWAY" :TR=TR+T1:GOSUB940:GO 

SUB70 0: RETURN 
1895 IFH1>2ORL<14ORL>19THEN1500 
1900 INPUT"DO YOU WISH TO SURRENDER" ; D$ : IFDS="NO"THEN1500 
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1910 PRINT'THE ";C1$;" ACCEPTS YOUR OFFER OF SURRENDER" :PRINT"YOU GIVE UP ALL TA 

LISMANS, MAGIC, TRESURE AND 20 DAYS FOOD" :D2=D2+20 :M1=0:TR=0 :FORA=0TO9 :T(A) =0 

:NEXT:PRINT"THE ";C1S;" WALKS HAPPILY AWAY" :GOSUB940:GOSUB700:GOSUB970 :GOTO 

570 
2000 ON RND( 11 )GOTO2010, 2030, 2050, 207 0,2090, 2110, 2130, 2140, 2150, 2160, 2170 
2010 PRINT"YOU MEET AN ELF":IF C+T(1)<5THENPRINT"BE GETS FRIGHTENED AND RONS AWA 

Y.":GOTO570 
2020 PRINT'THE ELF GIVES YOU A CHARM WHICH INCREASES YOUR MAGIC 1 POINT. " :M=M+1: 

M1=M1+1:GOTO570 
2030 PRINT'YOU MEET AN ENCHANTED FROG" : INPUT"DO YOU KISS IT";D$:IF DS="NO"THEN57 


2040 IFG=0THENPRINT"THE FROG IS CHANGED INTO A HANDSOME PRINCE WHO OFFERS YOU HI 

S LOVE AND A MAGIC CHARM WHICH INCREASES YOUR MAGIC 1 POINT" :M=M+1: M1=M1 + 

1:GOTO570 
2045 PRINT"THE FROG IS TURNED INTO A BEAUTIFUL PRINCESS WHO FALLS IN LOVE WITH 

YOU":PRINT"SHE GIVES YOU A MAGIC NECKLACE WHICH ADDS 1 TO YOUR MAGIC":M=M+1 

:M1=M1+1:GOTO570 
2050 PRINT"YOU MEET A HERMIT":IF C+T(1)<4PRINT"HE GETS FRIGHTENED AND RUNS AWAY. 

":GOTO570 
2060 PRINT"THE HERMIT GIVES YOU SIX DAYS WORTH OF FOOD TO BE RID OF YOU":Dl=Dl+6 

:GOTO570 
2070 PRINT"YOU MEET A SIMPLETON WHO OFFERS YOU SIX DAYS FOOD" :Dl=Dl+6 :GOTO570 
2090 PRINT"YOU MEET A KOBOLD" : IFC+T(3 )<3PRINT"HE IS FRIGHTENED AND DISAPEARS" :GO 

TO570 
2100 PRINT"HE LIKES YOU AND GIVES YOU A CHARM THAT ADDS 1 TO YOUR HEALTH" : H1=H1+ 

1:H=H+1:GOTO570 
2110 IFG=0ANDHKHPRINT"YOU MEET A ELF PRINCE WHO HEALS YOUR WOUNDS" :H1=H:GOTO570 
2120 IFHKHPRINT"YOU MEET A NYMPH WHO HEALS ALL YOUR WOUNDS" :H1=H:GOTO570ELSE570 
2130 IFHKHPRINT"YOU MEET A HEALER WHO HEALS YOUR WOUNDS" :H1=H:GOTO570ELSE570 
2140 IFH1=HTHEN2150ELSEPRINT"YOU DRINK FROM A MAGIC SPRING WHICH HEALS ALL YOUR 

WOUNDS" :H1=H:GOTO570 
2150 IFM1=MGOTO350ELSEPRINT"YOU EAT A MAGIC FRUIT WHICH RESTORES YOUR MAGIC":M1= 

M:GOTO570 
2160 PRINT"A LUCKY SHOT KILLS A WILD BOAR. YOU GET TWELVE MORE DAYS OF FOOD":Dl= 

D1+12:GOTO570 
2170 IFG=0PRINT"YOU MEET A UNICORN WHO ALLOWS YOU TO RIDE ON HIS BACK" :N=l:GOT05 

70 
2180 IFC+T(3)+T(1)>4PRINT"Y0U MEET A WINGED HORSE WHO ALLOWS YOU TO RIDE ON HIS 

BACK":N=1:GOTO570ELSE570 
2400 T=RND(3):CLS:T1=0:GOSUB2700:PRINT"YOU HAVE MADE IT TO THE ENCHANTED CASTLE" 

:PRINT"THE CASTLE CONTAINED :" ; : FORA=lTOT:ONRND(3) GOTO2500 ,2500 ,2530 
2500 T2=RND(20)*100:GOTO2640 

2530 ON RND( 10) GOTO2540, 2550, 2560, 2570, 2580, 2590, 2600, 2610, 2620, 2630 
2540 IFT(0)=1ORT(2)=1THEN2550ELSEPRINTT$(0);". THIS ADDS TWO TO YOUR COMBAT":T(0 

)=1:GOTO2640 
2550 IFT(1)=1THEN2560ELSEPRINTT$(1);".THIS ADDS ONE TO YOUR CHARISMA":T(l)=l:GOT 

026 40 
2560 IFT(2)=1ORT(0)=1THEN2570ELSEPRINTT$(2);".THIS ADDS ONE TO YOUR C0MBAT":T(2) 

=1:GOTO2640 
2570 IFT(3)=1THEN2580ELSEPRINTT$(3);".THIS WARDS OFF EVIL ANIMALS" :T(3) =l:GOT026 

40 
2580 IFT(4)=1THEN2590ELSEPRINTTS(4) ;".THIS SUBTRACTS ONE WOUND WHEN YOU ARE HIT" 

:T4=1:GOTO2640 
2590 IFT(5)=1THEN2600ELSEPRINTT?(5);" THIS ALLOWS YOU TO CAST THE BLAST SPELL FO 

R FREE":T(5)=1:GOTO2640 
2600 IFT(6)=1THEN2610ELSEPRINTTS(6);".THIS NEGATES ENEMY MAGIC":T(6) =1:GOTO2640 
2610 IFT(7)=1THEN2620ELSEPRINTT$(7);".THLS DESTROYS DEMONS" :T(7) =1:GOTO2640 
2620 IFT(8)=1THEN2630ELSEPRINTT$(8);" THIS REGENERATS MAGIC IN COMBAT" :T(8) =1:G0 

TO2640 
2630 IFT(9)=1THEN2540ELSEPRINTTS(9);".THIS HELPS YOU HEAL WHEN WOUNDED" :T(9) =1 
2640 T1=T2+T1:T2=0:NEXT:TR=TR+T1:PRINTT1;" TREASURE, YOU NOW HAVE ";TR:GOSUB940:G 

OSUB940:GOTO350 
2700 FORY=21T047:FORR=6T07:SET(R,Y) :SET(R+19,Y) :SET(R+92,Y) :SET(R+114 ,Y) :NEXTR,Y 

:FORR=0TO5:Y=21:SET(R,Y) :SET(R+26,Y) :SET(R+92,Y) :SET(R+122,Y) :NEXT:F0RY=15T 

O21:FORR=0TO1:SET(R,Y) :SET(R+30,Y) :SET(R+92,Y) :SET(R+126,Y) :NEXTR,Y 
2710 F0RR=1T031STEP4:SET(R,15) :SBT(R+1,15) :SET(R+94,15) :SET(R+95,15) :NEXT:FORR=0 

T031:SET(R,16) :SET(R+94 , 16) :NEXT:FORR=26T097STEP4:SET(R,26) :SET(R+1,26) :NEX 

T:FORR=26T097:SET(R,27) :NEXT 
2720 FORR=52T072:SET(R,38) :NEXT:FORY=39T047 :SET(52,Y) :SET(72,Y) :NEXT:FORR=0TO127 

:SET(R,47) :NBXT:RBTURN 
2990 PRINT"YOU RUN OUT FOOD AND DIE OF STARVATION" 
3000 PRINT"YOU ARE DEAD":IF RND(4)=1PRINT"Y0U ARE REINCARNATED WITH ALL YOUR FOR 

MER POWERS AND TALISMANS" :H1=H:M1=M:GOSUB940 : D=l :GOSUB700 :GOTO570ELSE3050 
3010 PRINT"YOU WIN":PRINT"YOU END UP WITH ";TR;" TREASURE" 

3020 IFTR>4000PRINT"YOU ARE A BIG WINNER! " :PRINT"YOU HAVE ENOUGH TREASURE DO BUY 
THAT PALACE YOU'VE DREAMED OF" : PRINT"YOU LIVE HAPPILY EVER AFTER FOR THE R 

EST OF YOUR DAYS":GOTO 3050 
3025 IFTR>2500PRINT"YOU DID ALRIGHT ,YOU HAVE ENOUGH TREASURE TO BUY ALMOST ANYT 

HING":GOTO3050 
3030 IFTR>1000PRINT"YOU HAVE ENOUH TREASURE TO LIVE COMFORTABLY FOR THE REMAINDE 

R OF YOUR LIFB":GOTO3050 
3040 PRINT"YOU DON'T HAVE ENOUGH TREASURE TO BUY EVEN A COTTAGE. YOU LIVETHE R 

EST OF YOUR LIFE IN JAIL FOR THIEVERY" :GOTO3050 
3050 GOSUB940:CLS:INPUT"WOULD YOU LIKE ANOTHER GAME",-A$: IFLEFT? (A5,l) ="Y"THEN10E 

LSEPRINT"OKAY , GOODBYE" 
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BASEBALL: by John Bodgers 



With this program, America's 
favorite pastime can now be your 
TRS-80's, as well. A full nine in- 
ning format, three choices of 
pitches, bat swing timing and oc- 
casional errors keep things in- 
teresting. An excellent choice for 
disgruntled Red Sox, Yankee and 
Dodger fans. 



lauaiiiiiiB 

aPMMMMi 



ems 3 STRIKES z ours ' 'Srauwi 



m sot »tuw ■. mis e 



5 CLS:PRINT"B A S E B A L L" 

7 PRINT-WOULD YOU LIKE INSTRUCTIONS.. . .1-YES 2-HO" :INPUTA:IPA=1THEN9750ELSE10 

IB CLS:INPUT"NAME OF 1ST TEAM";A? 

15 INPUT'NAME OF 2ND TEAM";BS:CLS 

55 FORA=0TO104:SET(A,1) :SET(A,7) :SET(A,13) :NEXTA 

62 F0RB=1T013 

65 SET{0,B) :SET(1B,B) :SET(2B,B) :SET(3B,B) :SET(4B,B) :SET(5B,B) 

67 SET(6B,B) :SET(7B,B) :SET(8fl,B) :SET(9B,B) :SET(104,B) :NEXTB 

70 PRINT8117,AS;:PRINT§245,B$; 

75 PRINT6111,U;:PRINTe239,Vi 

Bfl GOSUB507 

90 SET(42,38) :SET(43,37) :SET(43,39) :SET(44,38) 

100 SET(82,38) :SET(83,37) :SET(83,39) :SET(84,38) 

110 SET(62,30) :SET(63,29) :SET(63,31) :SET<64,30) 

120 SET(62,38) :SET(64,38) :SET(62,46) :SET(64,46) :W=36:X=90 

150 SET(X,W) :IFX=125THEN170ELSEW=W-2:X=X+5:GOTO150 

17 W=36:X=36 

180 SET(X,W) :IFX=1THEN190ELSEW=W-2:X=X-5:GOTO180 

190 PRINT§960,A$" BATTING", - 

200 PRINTH010,"RUNS" L; 

2B5 PRINTS365," "; 

210 RESET(63,46) :RESET(63,47) :SET(63,37) :GOSUB220:GOTO300 

220 BB=0:IFPOINT(83,38)PRINT«65,"MAN ON 1ST";:BB=1 

230 IFPOINT{63,30)PRINTe365,"MAN ON 2ND";:BB=2 

240 IFPOINT(43,38)PRINTe365,"MAN ON 3RD";:BB=3 

250 IFPOINT(83,38)IFPOINT(63,30)PRINT6365,"MAN ON 1ST & 2ND" ; : BB=4 

260 IFPOINT(83,38)IFPOINT(43,38)PRINTe365,"MAN ON 1ST 6 3RD";:BB=5 

270 IFPOINT(63,30)IFPOINT(43,38)PRINT8365,"MAN ON 2ND & 3RD";:BB=6 

280 IFPOINT(83,38)IFPOINT(63,30)IFPOINT(43,38)PRINT«65, "BASES LOADED ";:BB= 

7 
290 RETURN 
300 CC=0:EE=0 
325 IFS>16IFV+L>UTHEN5900 
350 O=0:D$=INKEY$:IFD$="1"THEN360 

352 IFD$="2"THENCC=1:GOTO360 

353 IFD$="3"THENCC=2:GOTO360 
355 GOTO350 

360 H=37 

370 AA=0:SET(63,H) :RESET(63,H-1) 

371 IFHO47THEN3B0ELSEZ=RND(5) : IFZ=3Z=1 

372 IFZ=4Z=2 

373 EE=EE+1 : IFEE=5THEN37 4ELSECS = INKEY$ :GOTO1550 

374 IFZ=5Z=1 

";:GOSUB8000:GOSUB490:RESET(63,H):GOTO 



375 IFZ=1J=J+1:PRINT9365, "STRIKE 

200 

376 IFZ=2I=I+l:PRINTe365,"BALL 

UB490:O=1:GOTO910 
37 8 GOTO200 

380 CS=INKEY$:IFCS=" "THENAA=1 
384 IFC$=" "IFH<46THENRESET(63,H) :Z=l:GOT0375 
387 IFAA=1IFH=46GOSUB500:GOTO900 
390 ONCCGOTO1500,1510 
395 H=H+1:GOTO370 

490 IFO=5J=J+l:RESET(63,46) 

491 IFO=7RESET(63,46) :J=0:T=0 

493 IFI=4J=0:I=0 

494 IFJ=3PRINTS365, "STRIKE OUT 

:SS=SS+1 



;:GOSUB80B0:GOSUB500:IFI=4I=0:J=0:GOS 



" : GOSUB5 07 : FORY=0TO200 : NEXTY : K=K+1 : J=0 : 1=0 
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500 IFK=3I=0:J=0:PRINTe322,Il"BALLS " J;"STRIKES " K;" 

502 IFK=3:PRINT§365,"3 OUTS ", :GOSUB8000:GOTO5900 

504 IPK-=3K=0 

507 PRINTe322,Ij"BALLS " J;"STRIKES " K; "OUTS" : RETURN 

900 0-=RND(9) :W=0 

901 IFO=90=5 

902 IFO=60=7 

903 IFO=80=7 

904 IF0=1PRINTS365, "SINGLE ":GOSUB8000 

905 IFO=2PRINT6365, "DOUBLE ":GOSUB8000 

906 IFO<5HH=HH+l 

907 GOT0925 
910 PRINT6365,"WALK ":GOSUB8000 :R£SET(63,47) :W=1 



925 IFO=5PRINTe365, "STRIKE 
940 IFO=3PRINT6365, "TRIPLE 
950 IFO=4PRINTe365,"H H E R U N 



GOSUB8000:GOSUB490:GOTO200 

GOSUB8000 

RR=RR+1:IFBB=7THEN955ELSEGOSUB8000:GOTO96 



953 GOTO960 

955 PRINTH65, "GRAND SLAM ":GOSUB8000 

960 IFO=7PRINT6365,"FLIED OUT " :GOSUB8000 : K=K+1 :GOSUB490 :GOTO200 

962 I=0:J=0:GOSUB507 

964 IFW=1IFBB=0THEN985 

966 IFW=1ONBBGOTO1000 , 985 , 985 , 1000 , 970 , 985 , 1000 

968 GOTO980 

970 BB=1:GOTO1000 

980 IFO=1IFBB=0THEN985ELSE1000 

981 IFO=2IFBB=0THEN1800ELSE1000 

982 IFO=3IFBB=0THEN1840ELSE1000 

983 IFO=4IFBB=0THEN1870ELSE1000 
985 GOSUB1400 

990 GOSUB1950:GOSUB2010:GOTO990 

1000 ONOGOTO1010, 1020, 1030, 1040 

1010 ONBBGOTO1050, 1060, 107 0,1080, 1090, 1100, 1110 

1020 ONBBGOTO1120, 1130, 1140, 1150, 1160, 1170, 1180 

1030 ONBBGOTO1190, 1200, 1210, 1220, 1230, 1240, 1250 

1040 ONBBGOTO1260, 1270, 1280, 1290, 1300, 1310, 1320 

1050 GOSUB1400 

1055 GOSUB1950:GOSUB2010:GOSUB3010:GOTO1055 

1060 GOSUB1400 

106 5 GOSUB1950:GOSUB2010:GOSUB4010:GOTO106 5 
1070 GOSUB1400 

107 5 GOSUB1950:GOSUB2010:GOSUB5010:GOTO107 5 
1080 GOSUB1400 

1085 GOSUBT9 50:GOSUB2010:GOSUB3010:GOSUB4010:GOTO1085 

1090 GOSUB1400 

1095 GOSUB1950:GOSUB2010:GOSUB3010:GOSUB5010:GOTO109 5 

1100 GOSUB1400 

1105 GOSUB1950:GOSUB2010:GOSUB4010:GOSUB5010:GOTO1105 

1110 GOSUB1400 

1115 GOSUB1950:GOSUB2010:GOSUB3010:GOSUB4010:GOSUB5010:GOTO1115 

1120 GOSUB1400 

1123 GOSUB1960:GOSUB2010:GOSUB3010:GOTO1123 

1125 GOSUB1400 

1127 GOSUB1950:GOSUB3010:GOSUB4010:GOTO1127 

1130 GOSUB1400 

1133 GOSUB1960:GOSUB2010:GOSUB4010:GOTO1133 

1135 GOSUB1400 

1137 GOSUB1950:GOSUB3010:GOSUB5010:GOTO1137 

1140 GOSUB1400 

1143 GOSUB1960:GOSUB2010:GOSUB5010:GOTO1143 

1145 GOSUB1400 

1147 GOSUB1950:GOSUB3010:GOTO1147 

1150 GOSUB1400 

1153 GOSUB1960:GOSUB2010:GOSUB3010:GOSUB4010:GOTO1153 

1155 GOSUB1400 

1157 GOSUB1950:GOSUB3010:GOSUB4010:GOSUB5010:GOTO1157 

1160 GOSUB1400 

1163 GOSUB1960:GOSUB2010:GOSUB3010:GOSUB5010:GOTO1163 

1165 GOSUB1400 

1167 GOSUB1950:GOSUB3010:GOSUB4010:GOTO1167 

1170 GOSUB1400 

1173 GOSUB1960:GOSUB2010:GOSUB4010:GOSUB5010:GOTO117 3 

1175 GOSUB1400 

1177 GOSUB1950:GOSUB3010:GOSUB5010:GOTO1177 

1180 GOSUB1400 

1183 GOSUB1960:GOSUB2010:GOSUB3010:GOSUB4010:GOSUB5010:GOTO1183 

1185 GOSUB1400 

1187 GOSUB19 50:GOSUB3010:GOSUB4010:GOSUB5010:GOTO1187 

1190 GOSUB1400 

1192 GOSUB1970:GOSUB2010:GOSUB3010:GOTO1192 

1194 GOSUB1400 

1195 GOSUB1975:GOSUB3010:GOSUB4010:GOTO1195 

1197 GOSUB1400 

1198 GOSUB1950:GOSUB4010:GOSUB5010:GOTO1198 
1200 GOSUB1400 

1202 GOSUB1970:GOSUB2010:GOSUB4010:GOTO1202 
1204 GOSUB1400 
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1205 GOSUB1975:GOSUB3010:GOSUB5010:GOTO1205 

1207 GOSUB1400 

1208 GOSUB1950:GOSUB4010:GOTO1208 
1210 GOSUB1400 

1212 GOSUB1970:GOSUB2010:GOSUB5010:GOTO1212 

1214 GOSUB1400 

1215 GOSUB1975:GOSUB3010:GOTO1215 

1217 GOSUB1400 

1218 GOSUB1950:GOSUB4010:GOTO1218 
1220 GOSUB1400 

1222 GOSUB1970:GOSUB2010:GOSUB3010:GOSUB4010:GOTO1222 

1224 GOSUB1400 

1225 GOSUB1975:GOSUB3010:GOSUB4010:GOSUB5010:GOTO1225 

1227 GOSUB1400 

1228 GOSUB1950:GOSUB4010:GOSUB5010:GOTO1228 
1230 GOSUB1400 

1232 GOSUB1970:GOSUB2010:GOSUB3010:GOSUB5010:GOTO1232 

1234 GOSUB1400 

1235 GOSUB1975:GOSUB3010:GOSUB4010:GOTO1235 

1237 GOSUB14 00 

1238 GOSUB1950:GOSUB4010:GOSUB5010:GOTO1238 
1240 GOSUB1400 

1242 GOSUB1970:GOSUB2010:GOSUB4010:GOSUB5010:GOTO1242 

1244 GOSUB1400 

1245 GOSUB1975:GOSUB3010:GOSUB5010:GOTO1245 

1247 GOSUB1400 

1248 GOSUB1950:GOSUB4010:GOTO1248 
1250 GOSUB1400 

1252 GOSUB1970:GOSUB2010:GOSUB3010:GOSUB4010:GOSUB5010:GOTO1252 

1254 GOSUB1400 

1255 GOSUB1975:GOSUB3010:GOSUB4010:GOSUB5010:GOTO1255 

1257 GOSUB1400 

1258 GOSUB1950:GOSUB4010:GOSUB5010:GOTO1258 

1260 GOSUB1400 

1261 GOSUB1980:GOSUB2010:GOSUB3010:GOTO1261 

1262 GOSUB1400 

1263 GOSUB19 83:GOSUB3010:GOSUB4010:GOTO126 3 

1264 GOSUB1400 

1265 GOSUB1986:GOSUB4010:GOSUB5010:GOTO1265 

1266 GOSUB1400 

1267 GOSUB1950:GOSUB5010:GOTO1267 

1270 GOSUB1400 

1271 GOSUB1980:GOSUB2010:GOSUB4010:GOTO1271 

1272 GOSUB1400 

127 3 GOSUB1983:GOSUB3010:GOSUB5010:GOTO127 3 

1274 GOSUB1400 

127 5 GOSUB1986:GOSUB4010:GOTO127 5 

1276 GOSUB1400 

1277 GOSUB1950:GOSUB5010:GOTO1277 

1280 GOSUB1400 

1281 GOSUB1980:GOSUB2010:GOSUB5010:GOTO1281 

1282 GOSUB1400 

1283 GOSl!B19 83:GOSUB3010:GOTO128 3 

1284 GOSUB1400 

1285 GOSUB1986:GOSUB4010:GOTO1285 

1286 GOSUB1400 

1287 GOSUB1950:GOSUB5010;GOTO1287 

1290 GOSUB1400 

1291 GOSUB19 80:GOSUB2010:GOSUB3010:GOSUB4010:GOTO1291 

1292 GOSUB1400 

1293 GOSUB1983:GOSUB3010:GOSUB4010:GOSUB5010:GOTO1293 

1294 GOSUB1400 

1295 GOSUB1986:GOSUB4010:GOSUB5010:GOTO1295 

1296 GOSUB1400 

1297 GOSUB1950:GOSUB5010:GOTO1297 

1300 GOSUB1400 

1301 GOSUB1980:GOSUB2010:GOSUB3010:GOSUB5010:GOTO1301 

1302 GOSUB1400 

1303 GOSUB1983:GOSUB3010:GOSUB4010:GOTO1303 

1304 GOSUB1400 

1305 GOSUB1986:GOSUB4010:GOSUB5010:GOTO1305 

1306 GOSUB1400 

1307 GOSUB1950:GOSUB5010:GOTO1307 

1310 GOSUB1400 

1311 GOSUB1980:GOSOB2010:GOSUB4010:GOSUB5010:GOTO1311 

1312 GOSUB1400 

1313 GOSUB1983:GOSUB3010:GOSUB5010:GOTO1313 

1314 GOSUB1400 

1315 GOSUB1986:GOSUB4010:GOTO1315 

1316 GOSUB1400 

1317 GOSUB1950:GOSUB5010:GOTO1317 

1320 GOSUB1400 

1321 GOSUB19 80:GOSUB2010:GOSUB3010:GOSUB4010:GOSUB5010:GOTO1321 

1322 GOSUB1400 

1323 GOSUB1983:GOEUB3010:GOSUB4010:GOSUB5010:GOTO1323 

1324 GOSUB1400 

1325 GOEUB1986:GOSUB4010:GOSUB5010:GOTO1325 
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1326 GOSUB1400 

1327 GOSUB1950:GOSUB5010:GOTO1327 

1400 X=0;A=63:B=46:C=83:D=38:E=63:F=30:G=43:H=38:RETURN 

1500 FORX=0TO5:NEXT:GOTO395 

1510 FORX=0TO13:NEXT:IFH=42THENCC=0:GOTO395 

1520 GOT0395 

1550 IFC$="""THENZ=l:GOT0374 

1560 GOT0373 

1800 GOSUB1400 

1810 X=X+1:IFX=6THEN1820ELSEGOSUB2010:GOTO1810 

1820 GOSUB1400 

1830 GOSUB1950:GOSUB3010:GOTO1830 

1840 GOSUB1400 

1845 X=X+1:IFX=6THEN1850ELSEGOSUB2010.:GOTO1845 

1850 GOSUB1400 

1855 X=X+1:IFX=6THEN1860ELSEGOSUB3010:GOTO1855 

1860 GOSUB1400 

1865 GOSUB1950:GOSUB4010:GOTO1865 

1870 GOSUB1400 

1875 X=X+1:IFX=6THEN1880ELSBGOSUB2010:GOTO1875 

1880 GOSUB1400 

1885 X=X+1:IFX=6THEN1890ELSEGOSUB3010:GOTO1885 

1890 GOSUB1400 

1895 X=X+1:IFX=6THEN1900ELSEGOSUB4010:GOTO1895 

1900 GOSUB1400 

1905 GOSUB1950:GOSUB5010:GOTO1905 

1950 X=X+1:IFX>5THENGOTO200 

1955 RETURN 

1960 X=X+l:IFX=60NBBGOT01125, 1135, 1145, 1155, 1165, 1175, 1185 

1965 RETURN 

1970 X=X+l:IFX=60NBBGOT01194, 1204, 1214, 1224, 1234, 1244, 1254 

1972 RETURN 

1975 X=X+1 : IFX=60NBBGOT01197, 1207 , 1217 , 1227 , 1237 , 1247 , 1257 

1977 RETURN 

1980 X=X+l:IFX=6ONBBGOT0126 2, 127 2, 1282, 1292, 1302, 1312, 1322 

1981 RETURN 

1983 X=X+l:IFX=60NBBGOT0126 4, 127 4, 1284, 1294, 1304, 1314, 1324 

1984 RETURN 

1986 X=X+1: IFX=60NBBGOT0126 6 , 1276 , 1286 , 1296 , 1306 , 1316 , 1326 

1987 RETURN 

2010 SET(A,B) :lFB<46RESET(A-5,B+2) 

2020 A=A+5:B=B~2: RETURN 

3010 SET(C.D) : RESET (C+5,D+2) 

3020 C=C-5:D=D-2: RETURN 

4010 SET(E,F) : RESET (E+5,F-2) 

4020 E=E-5:F=F+2: RETURN 

5010 IFG=68G=63 

5013 IFH=48H=46 

5016 SET(G,H) : RESET (G-5,H-2) 

5020 G=G+5 :H=H+2: IFG-63THBNL-L+1 :RESET (G, H) 

5030 RETURN 

5900 GOSUB220:PRINT@365," " ; : IFBB=10RBB=20RBB=3THENLL=LL+1 

5930 IFBB=40RBB=50RBB=6THENLL=LL+2 

5960 IFBB=7THENM.=IJ,+3 

6000 S=S+1:RESET(83,38) :RESET(63,30) :RESET(43,38) :IFS=10RS=19U=U+L:PRINT665,L; 

6020 IPS=2ORS=20V=V+L:PRINT8193,L; 

6030 IFS=3ORS=21U=U+L:PRINT870,L; 

6040 IFS=40RS=22V=V+L:PRINT8198,L; 

6050 IFS=50RS=23U=U+t,:PRINT87 5,L; 

6060 IFS=6ORS=24V=V+L:PRINT8203,L; 

6070 IFS=7U=U+L!PRINT@80,L; 

6080 IFS=8V=V+L:PRINT@208,Lf 

6090 IFS=9U=U+L:PRINT@85,t,; 

6100 IFS=10V=V+L:PRINT8213,L; 

6110 IFS=11U=U+L:PRINT890,L; 

6120 IFS=12V=V+L:PRINT8218,L; 

6130 IFS=13U=U+L:PRINT895,L; 

6140 IFS=14V=V+L:PRINT8223,L; 

6150 IFS=15U=U+L:PRINTI100,L; 

6160 IFS=16V=V+L:PRINT8228,L; 

6170 IFS=17U=U+L:PRINT8105,L; 

6180 IFS=18V=V+L:PRINT8233,L; 

6182 ONSGOTO90 00, 9500, 9000, 9500, 9000, 9500, 9000, 9500, 9000, 9500, 9000, 9500, 9000, 950 

0,9000,9500,90 00,9500,9000,9500,9000,9500,9000,9500 
6185 PRINT@111,U;:PRINT8239,V; 

6190 IFS=17IFV>UPRINT8235," X";:S=18 

6191 IFTT=1IFV=UTHEN6350 

6192 IFS=18IFV=UGOSUB8000:K=0:CLS:TT=1:L=0: PRINT-EXTRA INNINGS" :GOSUB8000 :CLS:GO 
T055 

6193 IFS=19ORS=21ORS=23THEN6350 

6194 IFS=18ORS=20ORS=22ORS=24PRINT@322,A$;" HITS "XX;" L.O.B "YY;" S.O. "ZZ;" 

H.R. "QQ 
6196 IFS=18ORS=20ORS=22ORS=24PRINT8386,B$;" HITS "UU; n L.O.B "W; " S.O. "WW;" 

H.R. "TT 
6200 IFS=18ORS=20ORS=22ORS=24IFU>VPRINT8183," WINNER" ; :GOSUB80 00: PRINT8183, " 
";:GOTO6200 
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WINNER", -:GOSUB8000: PRINT @3U," 



6300 IFS=18ORS=20ORS=22ORS=24IFV>UPRINTH11," 

",-:GOTO6300 
6350 HH=0:LL=0:SS=0:RR=0 
6400 IFK=3L=0:GOTO504 
7000 L=0:RETURN 
B000 FORX=0TO400:NEXT:RETURN 

9000 PRINT6960,BS" BATTING " ; :XX=XX+HH : YY=YY+LL: ZZ = ZZ+SS: QQ=QQ+RR: GOT06185 
9500 PRINT@960,AS" BATTING " ,- : UU=UU+HH : W=W+LL :WW=WW+SS: TT=TT+RR: GOT06185 
9750 CLS:PRINT"THIS IS A 2-PLAYER GAME" 
9760 PRINT"ENTER TEAM NAME THEN PRESS ENTER.. FIRST TEAM ENTERED BATS F URST (TEAM 

NAMES MUST BE LIMITED TO 11 LETTERS INCLUDING SPACES)" 
9770 PRINT"THE PITCHER HAS 3 CHOICES. . #1-KEY. .FAST BALL. .. J2-KEY .. SLOW BALL...J3 

-KEY.. CURVE BALL (COMBINATION OF SLOW AND FAST)" 
9780 PRINT"TO HIT BALL, BATTER MUST PRESS SPACE BAR WHEN BALL IS BETWE :EN THE 2 

SET POINTS AT BOTTOM OF SCREEN (PLATE)" 
9790 PRINT"IT WILL GIVE THE BATTER A RANDOM STRIKE, SINGLE, DOUBLE, TE«PLE, HOM 

ERUN, OR A -FLIED OUT-" 
9800 PRINT"IF BATTER ELECTS NOT TO PRESS SPACE BAR, HE WILL BE GIVEN A RANDOM BA 

LL OR STRIKE (IT IS POSSIBLE TO DRAW A WALK)" 
9810 PRINT"IF SPACE BAR IS PRESSED BEFORE THE BALL REACHES THE PLATE, OR AFTER I 

T PASSES THE PLATE, AN AUTOMATIC STRIKE RESULTS" 
9815 PRINT"PRESS ENTER TO CONTINUE" : INPUTA 
9820 CLS:PRINT"IN THE CASE OF A TIE, THE SCORE BOARD RESETS AND PLAY CONTINUES U 

NTIL THERE IS A WINNER" 
9840 PRINT"AT THE END OF THE GAME A LIST OF HITS, MEN LEFT ON BASE, STRIKE OUTS, 

AND HOME RUNS WILL BE DISPLAYED FOR EACH TEAM" 
9850 PRINT"PRESS ENTER TO BEGIN" : INPUTA:RUN10 



AIR RAID: by Kevin Copeland 



Good guys vs. enemy towns: 
level the town before being shot 
down. Watch your monitor sec- 
ond by second, as buildings 
crumble and bombs release. 
Unlike horse shoes, being "close" 
doesn't count in this program. 




1 CLS 

3 INPUT"DO YOU WANT INSTRUCTIONS (Y/N) ";A$ 

5 IFLEFTS(AS,1)="Y"THENGOSUB6000 

7 CLS 

10 S=0 

20 F=0 

30 M=3 

40 G=0 

45 H=0 

50 PRINT@30,"YOUR SCORE : " ;S:PRINT894, "MISSES LEFT 

60 FF=0 

90 FORJ=16TO110STEP2 

100 FORI=RND(6)*2+35T047STEP2 

110 SET(J,I) 

120 NEXTI 

130 NEXTJ 

150 P=6 

155 V=27 

160 K=l 

300 P=P+K+K:IFP>120THENGOSUB1000 

310 IFP<6THENGOSUB1000 

315 SET(P-1,V) 

320 SET(P,V) 
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322 SET(P-4*K,V-1) :RESET(P-6*K,V) :RESET(P-6*K,V-1) 

330 RESET(P-5*K,V) 

400 REM MOVE BOMB 

410 IFINKEY$=" "THENFF=1 

412 IFFFO1THEN600 

420 IFF=1THEN450 

425 F=l 

430 Y=V 

450 Y=Y+2 

460 RESET(P-2*K,Y-2) 

465 IFY>47THEN3000 

467 IFPOINT(P,Y)O0THENS=S+(47-V)*8:G=l 

470 SET(P,Y) 

600 REM 

999 GOTO300 

1000 REMPICK NEK DIRECTION + SET UP SHIP 

1001 IFY>47THENY=47 

1002 RESET(P-K-K,Y) 

1003 RESET(P-6*K,V-1) 

1005 F0RI=1T06:RESET(P-I*K,V) :NEXTI 

1010 K=l: P=6 : IFRNDf 2) =1THENK=-1 :P=120 

1020 V=RND(10)*2+5 

1030 IFG=0THENIFF=1THENGOSUB5000 

1040 F=0 

1050 IFH=0THENGOSUB5000 

1060 H=0 

1070 PRINT694, "MISSES LEFT : ";M; 

1075 FF=0 

1099 RETURN 

3000 REMFASTMOVE 

3002 PRINT694, "MISSES LEFT : ",-M; 

3005 PRINT630,"YOUR SCORE : ";INT(S/10! ; : FF=0 

3010 FORI=P-2*KTOP-2*K-12*KSTEP-2*K 

3030 T=49:FORJ=47T037STEP-2 

3040 IFPOINT(I,J)O0THENT=T-2:SET(I,T) 

3050 IFJOTTHENRESET(I,J) 

3060 NEXTJ:NEXTI:F=0 

3070 IFG=0TBENGOSUB5000 

3080 H=1:G=0 

3090 GOTO600 

4000 REM OUT OF MISSES 

4005 PBINT694, "MISSES LEFT : ";M; 

4006 PRINT60," "; 
4010 FORI=1TO1000:NEXTI 
4020 CLS 

4025 IFS>BTHENB=S 

4030 PRINT"YOUR FINAL SCORE : ";INT(S/10) 

4040 PRINT 

4045 PRINT"HIGH SCORE : ";INT(B/10) :PRINT 

4050 PRINT'DO YOU WANT TO PLAY AGAIN ";:Y=1:N=0 

4060 INPUTAS 

4070 IFLEFT$ (A$ , 1 ) ="Y"THENCLS : GOTO10 

4080 PRINT 

4090 PRINT'TOO - DA - LOO" 

4100 END 

5000 REM MISSED 

5010 M=M-1 

5015 PRINT694, "MISSES LEFT : ";M 

5020 F0RI=1T012 

5030 PRINT8150,"YOU MISSED" :PRINT80, ""; 

5035 FORJ=1TO50:NEXTJ 

5040 PRINT6150," ";:PRINT60,""; 

5045 FORJ=1TO50:NEXTJ 

5050 NEXTI 

5060 IFM<1THEN4000 

5070 G=0:B=1 

5080 RETURN 

6000 REM INSTRUCTIONS 

6010 CLS 

6015 PRINT 

6020 PRINT"INSTRUCTIONS FOR ** AIR-RAID **" 

6030 PRINT"WRITTEN FOR TBB TRS-80 LEVEL II WITH 4K BY KEVIN COPELAND. 

6050 PRINT:PRINT"THIS IS A TV-TYPE GAME WHERE YOU ARE THE PILOT" 

6060 PRINT"OF A WORLD WAR II BOMBER PLANE AND YOU HAVE BEEN" 

6070 PRINT'GIVEN THE TASK OF DEMOLISHING A SMALL TOWN IN" 

6080 PRINT"GERMANY. YOU HAVE AS MANY BOMBS AS YOU NEED," 

6090 PRINT "HOWEVER, YOU CAN ONLY MISS THREE TIMES. MORE THAN" 

6100 PRINT"THAT AND THE ENEMY HAS HAD A CHANCE TO SHOOT YOU" 

6110 PRINT"DOWN. GOING CLEAR ACROSS THE SCREEN WITHOUT DROPPING A" 

6113 PRINT"BOMB COUNTS AS A MISS." 

6120 PRINT"PRESS THE SPACE BAR TO DROP YOUR BOMBS." 

6130 PRINT"GOOD LUCK. ":PRINT"PRESS 'S' TO START THE GAME." 

6140 IFINKEY5="S"THENCLS:RETURN 

6150 GOTO6140 
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SKI RACER: by Mike Zielinski 



Ever wondered what it's like 
to be a downhill racer? Now 
you'll know. Choose your best 
event (giant slalom, slalom, 
downhill, etc.) and race the 
clock! Missed gates count against 
you, so keep your eyes on the 
course and fingers on the key- 
board. Up to ten players. Ski 
Heil! 




IB CLEAR 200 : DEFSTR A : DEPINT B-E,G, I-Q, S-Z 

20 DIM G(215),R$(10),R(10,4) : A=CHR$(34) 

38 AL=STRINGS (21,45) : AQ=STRINGS (5,62) : AQ=AQ+" " 

40 GOSUB 7000 

50 PRINT 6 910, AQ;"NEED INSTRUCTIONS (Y/N) "; : INPUT QS 

60 IF Q$=."Y" GOSUB 6000 

70 PRINT : PRINT AQ; "HOW MANY RACERS (UP TO TEN) " ,- : INPUT R 

80 IF R=1FORW=1TO500:NEXTW:CLS:GOTO100 

82 FORQ=l TO R 

85 IFR<1ORR>10THENPRINT"PLEASE, ONLY UP TO TEN" :FORI=1TO500:NEXTI:CLS :GOTO70 

90 PRINT" RACER i ")Q;:INPUT "NAME PLEASE";RS (Q) : NEXT 

95 FORP=1TO500:NEXTP:CLS 

100 PRINT : PRINT TAB(23) "1. GIANT SLALOM" 

110 PRINT TAB(23)"2. SLALOM" : PRINT TAB(23)"3. STRAIGHT GATES 

120 PRINT TAB(23)"4. RANDOM GATES" : PRINT : PRINT TAB(4) AQ; 

130 INPUT"WHICH COURSE DO YOU WISH TO RUN (1,2,3, OR 4) ";Q 

135 IFQ<10RQ>4THENPRINT"PLEASE, ONLY USE 1,2,3, OR 4" :FORI=1TO500:NEXTI :CLS:GOTO100 

140 PRINT TAB(ll) "ONE MOMENT WHILE I SET THE GATES . . ." 

150 F=l: ON Q GOSUB 8000,8200,8400,8600 : RN=1: IF R=l THEN 180 

160 FOR Z=l TO R : PRINT : PRINT TAB(22) R$(Z);" IS UP TO RACE" 

170 PRINT TAB (22) "FOR RUN NUMBER" ;RN 

180 PRINT: PRINT TAB(8) AQ; "PRESS <ENTER> WHEN READY TO RACE 

190 INPUT QS 

200 X=479:F=1:C=1:G=0:M=0:N=0:H=0 

210 CLS : GOSUB 2000 : CLS 

220 FOR T=8 TO 215:PRINT8 57 , (T-8)/10+H:PRINT@X, " [ " ; 

300 IF G(T)=0 GOTO 400ELSE ON F GOTO 310,320 

310 PRINTS G(T) ,"L";:F=2:GOTO 330 

320 PRINTS G(T) ,"R";:F=1 

330 G(T)=G(T)-512 

400 IF G(T-8)=0 GOTO 500 

410 G=G+1 : ON C GOTO 420,430 

420 C=2 : IF X>G(T-8) THEN 440ELSE 450 

430 C=l : IF X<G(T-8) THEN 440ELSE 450 

440 M=M+1 : PRINT g 320, "MISSED GATE";G; : GOTO 460 

450 H=H+ABS(G(T-8)-X)/10 

460 G(T-8)=G(T-8)+512 

500 S5=INKEYS : IF SSO"" THEN N=ASC(SS) 

510 IF N=65 X=X-8 ELSE IF N=59 X=X+8 

520 IF N=83 X=X-6 ELSE IF N=76 X=X+6 

530 IF N=68 X=X-4 ELSE IF N=75 X=X+4 

540 IF N=70 X=X-2 ELSE IF N=74 X=X+2 

550 IF X<=448 X=448 

560 IF X>=511 X=511 

600 PRINT 6 999,"" 

610 IF T=206 PRINT TAB(4) AL; " FINISH LINE " ; AL 

620 NEXT T 

630 FT=T/10+H+M*5 : GOSUB 4000 

640 PRINT 8 598, "YOU MISSED";M; "GATES 

650 PRINT TAB(8)"FOR A HANDICAPPED FINISH TIME OF"; 

660 PRINT FM"MIN. S"FS"SEC." 

670 IF R=l THEN 800 

680 R(Z,RN)=FT 

690 NEXT Z 

700 GOSUB 2500 ; GOSUB 2500 

710 IF RN>2 THEN 770 

720 CLS : PRINT TAB(20) "RESULTS AFTER " ; : ON RN GOTO 730,740 

730 PRINT"FIRST HEAT" : GOTO 750 

740 PRINT"SECOND HEAT" 



93 



750 GOSUB 3000 

760 GOSUB 5000 

770 RN=RN+1 : IF RN<4 THEN 160 

780 CLS : PRINT TAB(20) "FINAL RACE RESULTS" 

790 PRINT "FINISH"; : GOSUB 3000 

800 PRINT : PRINT TAB(12) AQ; "WANT TO RACE AGAIN (Y/N) "; 

810 INPUT QS 

820 IF Q$="N" PRINT : PRINT "OK BUT I'M ALWAYS..." : END 

830 IF R=l THEN 200 

840 FOR Z=l TO R : FOR Y=l TO 4 : R(Z,Y)=0 : NEXT Y,Z 

850 GOTO 100 

2000 PRINT CHR$ (23): PRINT S 26 , "THREE" :GOSUB2500 

2010 PRINT 626," TWO ":GOSUB 2500: PRINT 626," ONE":GOSUB 2500 

2020 RETURN 

2500 FOR 0=1 TO 500 : NEXT : RETURN 

3000 PRINT TAB(24)"HEAT NUMBER" TAB(53) "TOTAL" 

3010 PRINT"POSITION"TAB(16) "1"TAB(29) "2"TAB(42) "3"TAB(54) "TIME" 

3020 PRINT AL;AL;AL 

3030 FOR Z=l TO R : R(Z, 4) =R(Z,1) +R(Z,2) +R(Z,3) : NEXT Z 

3040 IF RN<3 THEN 3120 

3050 FOR Q=l TO R : FOR Z=l TO R-l 

3060 IF R(Z,4)<=R(Z+1,4) THEN 3110 

3070 Z$=R$(Z) : Z1=R(Z,1) : Z2=R(Z,2) : Z3=R(Z,3) : Z4=R(Z,4) 

3080 R$(Z)=RS(Z+1) : FOR Y=l TO 4 : R(Z,Y) =R(Z+1,Y) : NEXT Y 

3090 R$(Z+1)=Z$ : R(Z+1,1)=Z1 : R(Z+1,2)=Z2 

3100 R(Z+1,3)=Z3 : R(Z+1,4)=Z4 

3110 NEXT Z,Q 

3120 FOR Z=l TO R : PRINT Z;R$(Z); : FOR Y=l TO 4 

3130 FT=R(Z,Y) : GOSUB 4000 

3140 PRINT TAB(13*Y) FM$":"FS$; 

3150 NEXT Y : PRINT : NEXT Z 

3160 RETURN 

4000 FM=INT(FT/60) : FS=INT( (FT-(FM*60) ) *10)/10 

4010 FM$=STR$(FM) : FSS=STR${FS) : FS$=RIGHT$ (FSS,LEN(FS$)-1> 

4020 IF FS<10 THEN FS$="0"+FS$ 

4030 RETURN 

5000 PRINT : PRINT TAB(14) AQ; "PRESS <ENTER> TO CONTINUE "; 

5010 INPUT Q$ 

5020 RETURN 

6000 CLS : PRINT @ 19, "THIS IS A GAME OF SKI RACER" 

6010 PRINT 6 75,AL;AL 

6020 PRINT" THE OBJECT OF THE GAME IS TO STEER YOUR SKIER "; 

6030 PRINT"DOWN THE MOUNTAIN PAST THE GATES YOU "; 

6040 PRINT" ENCOUNTER, AROUND THE LEFT OF THE GATES LABELED "; 

6050 PRINT A"L"A" AND THE RIGHT OF THE GATES LABELED "A°R=A" . 

6060 PRINT" YOU CONTROL THE SKIER WITH THE KEYS ON BOTH "; 

6070 PRINT"SIDES OF THE "A"G"A" 4 "A"H"A" KEYS. POSITION YOUR"; 

6080 PRINT" HANDS AS IF YOU WERE TYPING, LEAVING THE "A"G"A; 

6090 PRINT" & "A"H"A" EXPOSED. 

6100 PRINT" YOUR LITTLE FINGERS MOVE THE SKIER TO THE "; 

6110 PRINT"LEFT AND RIGHT AT THE FASTEST RATE AND YOUR INDEX"; 

6120 PRINT" FINGERS THE SLOWEST RATE. THE MIDDLE AND RING "; 

6130 PRINT"FINGERS ARE IN A RANGE BETWEEN THE FASTEST AND "; 

6140 PRINT"THB SLOWEST RATES. EXPERIMENT 11 

6150 GOSUB 5000: GOSUB 6500 

6160 PRINT" IN SKI RACING, THE BEST TIME CAN BE ACHIEVED BY"; 

6170 PRINT" CUTTING THE GATES AS CLOSE AS POSSIBLE. IT IS 

6180 PRINT"LEGAL TO KNOCK GATES DOWN, PROVIDED YOU HIT ": 

6190 PRINT"THEM FROM THE CORRECT SIDE. 

6200 PRINT" EACH GATE YOU MISS HANDICAPS YOUR TIME BY 5 "; 

6210 PRINT" SECONDS. ON ALL OF THE RACE COURSES, THE FIRST 

6220 PRINT"GATE IS ALWAYS A LEFT." : PRINT 

6230 PRINT" OH YES, AND A PERFECT TIME IS 21.6 

6240 GOSUB 5000: GOSUB 6500 

6250 PRINT" IF THERE IS MORE THAN ONE SKIER, A CONTEST IS "; 

6260 PRINT"HELD CONSISTINGOF THREE HEATS. THE WINNER IS ",- 

6270 PRINT" BASED ON THE BEST TOTAL TIME OF ALL THREE HEATS. 

6280 PRINT" ALL SKIERS RUN IN ORDER IN EACH HEAT. AT THE "; 

6290 PRINT'END OF EACH HEATI WILL LIST THE SKIERS AND THEIR" ; 

6300 PRINT" TIMES. AFTER THE THIRD HEAT I WILL LIST THE 

6310 PRINT"SKIERS IN THEIR FINISH POSITIONS WITH ALL "; 

6320 PRINT'TIMES AND TOTALS. 

6330 RETURN 

6500 CLS : PRINT 6 24, "S K I RACER": PRINT @ 75, AL;AL 

6510 RETURN 

7000 CLS : PRINT 6 88, "S K I R A C E R" : FOR Q2=l TO 10 

7010 READ QS,QF : FOR Q=QS TO QF : READ Z 

7020 POKE Q,Z : NEXT Q,Q2 

7030 RETURN 

7040 DATA 15559,15592,136,172,141,140,176,176,144,32,32,32,32 

7050 DATA 32,32,32,32,32,160,176,184,140,140,140,140,180,176 

7060 DATA 32,160,188,191,191,191,189,188,144 

7070 DATA 15629,15656,130,131,131,140,140,164,176,184,134,131 

7080 DATA 131,32,32,32,32,32,32,32,32,131,191,159,135,131 

7090 DATA 143,191,191,149 

7100 DATA 15684,15719,176,180,176,176,176,176,176,176,176,176 

7110 DATA 176,176,176,184,134,129,32,131,131,137,140,140,176 
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7120 DATA 184,151,32,160,152,135,130,1461,140,140,140,130,131 

7130 DATA 15749,15783,129,32,32,32,32,32,32,32,32,32,168,151,32 

7140 DATA 32,32,32,32,32,32,32,184,135,32,130,191,179,140 

7150 DATA 140,164,176,176,176,176,140,180 

7160 DATA 15824,15847,139,172,176,176,176,176,176,176,176,178 

7170 DATA 179,179,131,131,131,163,151,151,131,131,131,131 

7180 DATA 131,129 

7190 DATA 15897,15904,160,158,129,32,176,140,163,134 

7200 DATA 15959,15967,176,140,131,160,152,135,32,152,129 

7210 DATA 16021,16058,184,135,32,32,136,183,176,144,134,32,32 

7220 DATA 32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32 

7230 DATA 32,32,32,32,32,32,32,32,32,160 

7240 DATA 16065,16125,140,140,140,140,140,140,140,140,140,140 

7250 DATA 140,140,140,140,140,140,140,140,140,140,143,143 

7260 DATA 143,159,143,143,143,143,143,172,140,140,140,140 

7270 DATA 140,140,140,140,140,140,140,140,140,140,140,140 

7280 DATA 140,140,140,140,140,140,140,140,140,140,140,135 

7290 DATA 32,32,160 

7300 DATA 16132,16189,140,140,140,140,140,140,140,140,140,140 

7310 DATA 140,140,140,140,140,140,140,140,140,140,143,143 

7320 DATA 143,143,143,143,143,143,143,140,140,140,140,140 

7330 DATA 140,140,140,140,140,140,140,140,140,140,140,140 

7340 DATA 140,140,140,140,140,140,140,140,140,140,140,135 

8000 GOSUB9000 

8010 FOR Q=16TO 200 STEP 9 : ON P GOTO 8020,8030 

8020 G(Q)-978:P»2:NEXTlRETURN 

8030 G(QJ=1005:F=1:NEXT:RETURN 

8200 GOSUB9000 

8210 POR Q-16TO 200 STEP 6 : ON P GOTO 8220,8230 

8220 G(Q)=987:F=2:NEXT:RETURN 

8230 G(Q)=996!F=l:NEXT:RETORN 

8400 GOSUB9000 

8410 FORQ=16TO200 STEP 4:G(Q) =99 2: NEXT: RETURN 

8600 GOSUB 9000 :Q=8 

8610 RT=RND(20)+998 : LT=RND(20) +965 

8620 ST=((RT-LT)/6)+RND((RT-LT)/10) 

8630 Q=Q+ST 

8640 ON F GOTO 8650,8680 

8650 G(Q)=LT : F=2 

8660 RT=RND(20)+998 

8670 IP Q>190 RETURN ELSE 8620 

8680 G(Q)=RT : F=l 

8690 LT=RND(20)+965 

8700 IF Q>190 RETURN ELSE 8620 

9000 FORQ=0TO215:G(Q)=0:NEXTsRETURN 
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PETALS AROUND THE ROSES: by Jim Wright 



Guess the outcome of a roll of 
five dice. Only two clues are 
given, but if you're quick at 
discerning patterns and finding 
order amidst chaos, you'll love 
this program. 



: on FETH.S sfMHic p«e an 

'" -f 01 KT-Cf'IHIS-SK IS TO GUESS HTHMf 10 TIC WM 
FW fIC£. 191 GET TO CLUES. !» H WK Of K G« : !:- ■' ' 
•i(M. : *** M KSt' *S :■ JU aSOS * TO 1JHK. 

filWirYt^lomrftuirt 

GET SIX CORSECT ffSOS III AMI. ; If YOU MPT mil .WE.' 
CfHKT tfSfflnO (W KLL I UILL GIC IT TO YOU. 

J ' -' '■' ' : --Titewsr:.TteDiTEB-tefe=3=== ■■ 



; tt€ CffKO (*SO IS 14' . H HOU BSY 
-f£SS Tl£Ofltp>rn0ifG!N.-' 



10 DEFINTI:CLS 

12 PRINT" **** PETALS AROUND THE ROSE ****" 

14 PRINT"THE OBJECT OF THIS GAME IS TO GUESS THE ANSWER TO THE THROW" 

15 PRINT'OF FIVE DICE. YOU GET TWO CLUES. "; 

16 PRINT"1) THE NAME OF THE GAME IS" 

17 PRINT" 'PETALS AROUND THE ROSE' AND 2) ALL ANSWERS ARE EVEN NUMBERS. 

18 PRINT"SO THAT I KNOW THAT YOU ARE NOT JUST A LUCKY GUESSER" ; 

19 PRINT" YOU MUST" 

20 PRINT"GET SIX CORRECT ANSWERS IN A ROW. IF YOU DON'T "; 

21 PRINT"KNOW THE " 

22 PRINT"CORRECT ANSWER TO ANY ROLL I WILL GIVE IT TO YOU." 

23 PRINT"FOR A SAMPLE ROLL PRESS THE ENTER KEY " ; : INPUTA$ :H=1 :GOT041 

24 PRINT"PRESS THE ENTER KEY TO BEGIN THE GAME ";:INPUTAS 

27 PRINT876 8,"THE CORRECT ANSWER IS";T;". SEE HOW EASY IT IS II" 

28 PRINT"PRESS THE ENTER KEY TO BEGIN ";:INPUTAS 

39 H=2:C=0 

40 CLS:PRINT"I'M SHAKING THE DICE " ; : FORI=1TO2000 :NEXTI :CLS 

41 Y=24:T=0:FORX=15 TO 85 STEP17 :N=RND(6) 

42 IF(N/2-INT(N/2)=0)THENGOTO50 
44 T=T+N-1 

50 FORI=XTOX+13:FORJ=YTOY+6 
60 SET(I,J) :NEXTJ:NEXTI 

100 ON N GOSUB1010, 1020, 1010, 1030, 1010, 1020 
110 ON N GOSUB1070, 1070, 1020, 1020, 1020, 1030 
120 ON N GOSUB1070, 1070, 1070, 1070, 1030, 1040 
125 IFH=3 GOTO 2015 
130 NEXTX 
135 IF H-l GOTO 27 

150 PRINT@128,"TYPE IN THE ANSWER YOU THINK IS CORRECT." 
155 PRINT"IF YOU HAVE NO IDEA TYPE IN 'P' FOR PLEASE HELP ME 

160 AS = "":INPUTAS 

161 ONERRORGOTO1160 
165 A=VAL(A$) : IFA=TGOTO200 
170 C=0:IFASC(A$)=80GOTO230 
17 5 GOTO250 

200 C=C+l:PRINTe896," 

201 PRINTe960,"THAT'S";C;"IN 

203 IFC<6GOTO205 

204 FORL=1TO3000:NEXTL:GOTO1100 

205 PRINT"LET'S SEE YOU DO IT AGAIN"; 
210 FORL=1TO3000:NEXTL:GOTO40 

230 PRINT6896, "DON'T GIVE UP SO EASILY, THE ANSWER IS";T;"." 

231 PRINT6960,"TYPE IN 'S' FOR IT'S SIMPLE I'LL TRY AGAINII"; 

232 INPUTAS:GOTO40 

250 PRINT(?896,"AWWWW! 1 1 YOU JUST ARN'T THINKING SIMPLE ENOUGH THE" 

251 PRINT8960, "ANSWER IS";T;". TYPE IN 'A' FOR PETALS AROUND THE ROSE 

252 INPUTA$:GOTO40 

1010 RESET(X+6,Y+3) :RESET(X+7 , Y+3) :RETURN 

1020 RESET(X+10,Y+1) :RESET(X+11 , Y+l ) : RESETIX+3 , Y+5) :RESET(X+4 ,Y+5) :RETURN 

1030 RESET(X+3,Y+1) :RESET (X+4 , Y+l) :RESET(X+10 , Y+5) : RESET (X+ll , Y+5) :RETURN 

1040 RESET(X+3,Y+3) :RESET(X+4 , Y+3) :RESET(X+10 , Y+3) : RESET (X+ll , Y+3) :RETURN 

107 RETURN 

1100 CLS 

1105 PRINT"CONGRATULATIONS! 1 I YOU ARE NOW ONE OF THE HOLDERS OF" 

1110 PRINT"THE 'SECRET OF THE ROSE'. JUST AS YOU CAME THROUGH" 

1115 PRINT"MANY TRIALS AND FRUSTRATIONS TO CRACK THE SECRET YOU" 

1120 PRINT"MUST NOW VOW TO ALLOW ALL OTHERS TO SHARE THE SAME" 

1125 PRINT"FRUSTRATIONS. EVEN UNDER THREATS TO YOUR LIFE YOU" 

1130 PRINT"MUST PLEDGE NEVER TO TELL ANYONE THE 'SECRET'. 

1135 Y=1:N=2 



******** YEA1 lllllll* 
ROW CORRECT 
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1140 PRINT:PRINT"WOULD YOU LIKE TO CONTINUE AND FRUSTRATE ANOTHER Y/N 

114 5 INPUTA$:IFA$="Y"ORA$="YES"GOT01 

1150 CLS:END 

1160 RESUME150 

2000 CLS: RESTORE :C=0:H=3 

2003 CLS:T=0 

2005 FORX=15T085STEP17:READN 

2010 GOT042 

2015 NEXTX 

2020 C=C+1:IFC=3 RESTORE 

2025 PRINT8896,"THE ANSWER IS";T; 

2030 PRINT"ENTER l)TO CONTINUE TEST 2)TO START GAME "; 

2035 INPUTZ 

2040 ON Z GOTO 2003,1 

2045 DATA 4,1,6,3,6,5,6,5,4,4,6,5,6,2,2 



BATTLESHIP: by Ty Halderman 



Drama on the high seas. Posi- 
tion your five vessels as you 
choose to open this game. Then 
let the computer do the same. 
Conduct a careful search for the 
enemy, then take your best shot. 
Computer may tend to cheat a 
little in this game. 
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5 CLS:PRINTCHR${23) : PRINT6530 , "BATTLESHIP" :PORT=1TO1000 :NEXT 

15 CLS:CLEAR50:GOSUB 60 

20 CLEAR:DIMM$(11,11),C$(10,10),H$(11,11):RANDOM:SK$="I HAVE SUNK YOUR " 

25 DEFFNX(AS)=ASC(A$)-64:DEFFNZ<A$)=VAL(RIGHT$(A$,1)) :DEFFNY(A$)= 

FNZ(A$)*(FNZ(A 

S)O0)*(-1)-10*(FNZ(A$)=0) 
30 FORI=1T05:READA$(I) ,S(I) ,LS(I) :NEXT 
35 DATA AIRCRAFT CARRIER, 4, A, BATTLESHIP, 3, B, CRUISER, 2, C, SUBMARINE, 2, S,PT BOAT,l, 

P 
40 FORI=0TO11:FORJ=0TO11:H$(I,J)=" ":HS (I, J) =". " rNEXTJ, I 
45 FORI=1TO10:FORJ=1TO10:H?(I,J)=".":CS(I,J)=".":NEXTJ,I 
50 F0RI=lTO4:S$(I)=" ":NEXT 
55 GOTO 80 
60 GOSUB 570 

65 PRINTCHR$( 27) "ENTER ONE ENDPOINT OF YOUR SHIP, AND THEN THE DIRECTION FROM 
TH 

AT POINT ~ <L>EFT <R>IGHT <U>P <D>OWN ." 
70 PRINT'A POINT MAY BE ENTERED AS Al OR A-l OR A,l OR A 1 
FOR A-10, YO 

U MAY ENTER JUST A 
7 5 RETURN 

80 FORI=lT05:GOSUB 570 
85 PRINT8768,CHR$(30);:PRINTAS(I) " - "SID+1" LONG : "; :LINEINPUT" BEGINNING POI 

NT ? ";X1?:X1=FNX(X1$) :Y1=FNY(X1$) 
90 PRINTCHR?(30) ; : INPUT"DIRECTION " ;X2S : IFX2$="U"THENX2=X1 :X1=X1-S( I) :Y2=Y1:IFX1 

<1THEN 125 
95 IFX2S="D"THENX2=X1+S(I) : Y2=Y1 : IFX2H0THEN 125 
100 IFX2S="R"THENY2=Y1+S(I) :X2=X1:IFY2>10THEN 125 
105 IFX2$="L"THENY2=Y1:Y1=Y1-S(I) :X2=X1 : IFYK1THEN 125 
110 IFX1>10ORXK1ORY1>10ORYK1THEN 125 
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115 IFX2SO"R"ANDX2$<>"L"ANDX2S<>"U"ANDX2S<>"D"THEN 125 

120 GOTO 130 

125 PRINT-ERROR HADE : RE-ENTER l":GOTO 85 

130 FORJ=X1TOX2:FORK=Y1TOY2 

135 IFHS(J,K) <>"."THENPRINT"THERE'S ALREADY A SHIP THERE. °:GOTO 85 

148 NEXTK,J 

145 F0RJ=X1T0X2:F0RK=Y1T0Y2:HS(J,K)=LS(I) :NEXTK,J 

150 NEXT IiGOSUB 570 : PRINT: PRINT"STAND BY WHILE I TRY TO HIDE MY SHIPS FROM YO 

U." 
155 C2=1:C4=2:C6=3:C1=RND(3) :C3=C1+1: IFC3=4THENC3=1 
160 C5=C3+1:IFC5=4THENC5=1 
165 F0RI=1T05 
170 Z=RND(0) 

175 IFZ>.5THENX1=RND(10-S(I) ) :Y1=RND(10) : Y2=Y1 :X2=X1+S ( I) :GOTO 185 
180 Y1=RND(10-S(I) ) :X1=RND(10) :X2=X1: Y2=Y1+S (I) 
185 FORJ=X1TOX2:FORK=Y1TOY2:IFRND(0)>.85GOTO 195 
190 IFHS(J,K+l)<>"."0RHS(J+l,K)<>"."0RHS(J-l,K)O"."THEN 170 
195 IFH$(J,K)O"."0RHS(J,K-l)<>"."THEN 170 
200 NEXTK,J 
205 FORJ=X1TOX2:FORK=Y1TOY2:HS(J,K)=LS(I) :NEXTK,J 

210 NEXTI:PRINTe768,CHR$(30)"OK I'M READY II" 

215 IFCC=i7THENPRINT:PRINT"YOU WON Il":GOTO 445 

220 IFCM=17THENPRINT:PRINT"YOU LOST II HERE ARE THET7-CCHITS YOU DIDN'T HAKE 

:":GOSUB 450 :GOTO 445 
225 LINEINPUT"YOUR SHOT " ; AS :A=FNX ( AS) :B=FNY(A$) 

230 IFA>10ORB>10ORA<1ORB<1THENPRINT"YOU GOOFED 1 "CHRS (27 ) CHRS (29) ;: GOTO 225 
235 IFCS(A,B)O"."THENPRINT"Y0U ALREADY SHOT THERE 1 "CHRS (27) CHRS (29) ; :GOTO 225 
240 PRINT"WATCH THE RADAR BLIP ..." 

245 IF H$(A,BX>"."THENCS(A,B)=HS(A,B) :CC=CC+1 :HS (A,B) =" . " :ELSE 
CS(A,B)="*" 
250 GOSUB 570 

255 ONHGOTO 355 , 400 , 400 , 400 

260 IFSS(1)=" "ANDSS(2)=" "ANDSS(3)=" "THENR=0:GOTO 290 
265 F0RQI=1T04:IFSS(QI)<>" "THEN 275 
270 NEXTQI 

275 F0RI=1T05:IFS$(QI)=LS(I)THEN 285 
280 NEXT I 

285 SS(QI)=" ":H=1:X=X(QI) :Y=Y(QI) :GOTO 355 
290 A=RND(10):B=RND(10) : IFCH=15ANDGF=1THEN 325 
295 BS=B:AS=A 

300 IFB>3THENB=B-3:GOTO 300 
305 IFA>3THENA=A-3:GOTO 305 
310 IFCM=15THENCG=CG+1 : IFCG=50THENGF=1 

315 IPA=C1ANDB=C20RA=C3ANDB=C40RA=C5ANDB=C6THEN 320 ELSE 290 
320 A=AS:B=BS 

325 IFHS(A,B)="H"ORHS(A,B)="*"GOTO 290 

330 IFCM>=12ANDPX=10RCM=15THENGOSUB 460 : IFSP<SLTHHEN310 
335 IFMS(A,B)="."THENHS(A,B)="*":GOSUB 570 :GOTO 215 
340 H=1:X=A:Y=B:F0RI=1T05:IFHS(A,B)=LS(I)THEN 350 
345 NEXT I 

350 M$(A,B)="H":CH=CH+l:GOSUB 570 :GOTO 215 
355 2=RND(4) :ONZGOSUB 530 , 525 , 540 , 535 

360 IFHS(X+P,Y+Q)="H"ORMS(X+P,Y+Q)="*"ORMS(X+P,Y+Q)=" "THEN 355 
365 SL=0:SP=l:A=Ot:B=Y:ONZGOSUB 465 , 465 , 500 , 500 : IFSP>=S(I)+lGOTO 370 ELSE 

355 
370 IFHS(X+P,Y+Q)="."THENMS(X+P,Y+Q)="*":GOSUB 570 :GOTO 215 
375 IFHS(X+P,Y+QX>LS(I)THENR=R+1:SS(R!=HS(X+P,Y+Q) :MS(X+P,Y+Q) ="H" :CM=CH+l:GOS0 

B 570 :X(R)=X+P:Y(R)=Y+Q:GOTO 215 
380 HS(X+P,Y+Q)="H":CH=CH+l:H=2:GOSUB 570 :P=P*2:Q=Q*2 
385 IFH=S(I)+1THENH=0:PRINTSKS;AS(I) 
390 IFI=5THENPX=1 
395 GOTO 215 

400 IFHS(X+P,Y+Q)="."THENMS(X+P,Y+Q)="*":GOTO 410 
405 GOTO 415 

410 ONZGOSUB 525 , 530 , 535 , 540 :GOSUB 570 :GOTO 215 
415 IFHS(X+P,Y+Q)="*"ORMS(X+P,Y+Q)=" "THENCK=l:ONZGOSUB 525 , 530 , 535 , 540 

420 CK = 0:IFHS(X+P,Y+Q)OLS(I)THENR=R+1 

425 IFHS(X+P,Y+Q)OLS(I)THENSS(R)»HS(X+P,Y+Q) :MS (X+P,Y+Q) ="H" :CM=CH+1:X (R) =X+P :Y 

(R)=Y+Q:GOSUB 570 :GOTO 215 
430 HS(X+P,Y+Q)="H":CH=CH+l:H=H+l:GOSUB 570 :GOSUB 545 
435 IFH=S (I) +1THENH=0 : PRINTSKS ; AS ( I) 
440 GOTO 215 
445 INPUT"WOULD YOU LIKE TO PLAY AGAIN", -FS:IFCHRS (ASC(FS) ) ="Y"THEN 20 ELSECLS : EN 

D 
450 FORHH=1TO10:FORYY=1TO10:HS(HH,YY)=HS(HH,YY) :NEXT:NEXT 
455 GOTO 57 
460 SL=17-CH:SP=1 
465 FORF=A+1TOA+4:IFF>10THEN 485 

470 IFHS(F,B)O"H"ANDMS(F,B)O"*"THENSP=SP+l:G0T0 480 
475 GOTO 485 
480 NEXT F 

485 F0RF=A-1T0A-4STEP-1:IFF<1THEN 495 
490 IFHS (F,B) <>"H"ANDHS (F,B) <>"*"THENSP=SP+1 :NEXT 
495 IFSP>=SLTHENRETURN 
500 SP=1:FORF=B+1TOB+4:IFF>10THEN 510 
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505 
510 
515 
520 
525 
530 
535 
540 
545 
550 
555 
560 
565 
570 
575 
580 
585 
590 
595 

600 



IFM$(A,F)0"H"ANDM$(A,F)0"*"THENSP=SP+1:NEXT 

F0RF=B-1T0B-4STEP-1 : IFF<1THENRETURN 

IFM$(A,F)<>"H"ANDMS(A,F)<>"*"THENSP=SP+1:NEXT 

RETURN 

P=-1:Q=0: RETURN 

P=1:Q=0: RETURN 

P=0:Q=-1:RETURN 

P=0:Q=1: RETURN 

IFP>0THENP=P+1 

IFP<0THENP=P-1 

1FQ>0THENQ=Q+1 

IFQ<0THENQ=Q-1 

RETURN 

PRINTCHRS(28) ; 

PRINTTAB{34)"1 



3 4 5 6 7 8 9 10"; 
10"CHRS(26)CHR$<29); 



PRINTTAB(4)" 
2 3 4 5 6 7 
FORIL=1TO10:PRINTCHR$(IL+64)TAB(4); 
FORIC=1TO10:PRINTM$(IL,IC) ;: PRINT" ";:NEXT IC 
PRINT"O";:FORTT=1TO20:NEXT:PRINTCHR$(8)CHR$(8); 
PRINTTAB(30)CHR$(IL+64)TAB(34);:FORIC=1TO10:PRINTC$(IL,IC);: PRINT" 

: PRINTCHR$ ( 26 ) CHR$ ( 29 ) ; : NEXTIL: PRINTCHR$ (31 ) : RETURN 
' PROGRAM NOTES : THIS PROGRAM REQUIRES 16K LEVEL II WITH 
DISK BAS 
IC ( DEFINED FUNCTIONS ARE USED ) . WITHOUT 

THIS REM STATEMENT, IT 
USES ABOUT 580 BYTES. 

REM STATEMENTS WERE LEFT OUT TO CONSERVE RAM, AS THIS 
PROGRAM WI 
LL USE MOST OF AVAILABLE USER RAM IN THE 
ABOVE SYSTEM. REMOVE THIS 
STATEMENT S 600 BEFORE 
RUNNING. 



WORD SEARCH: by Len Gorney 



Here we have two different 
versions of the old puzzle, with 
the TRS-80 doing the searching. 
Input the puzzle matrix in a 
fourteen by fourteen, displayed 
configuration or choose a fifty by 
fifty matrix without display. Tell 
the computer how many letters 
in the word, input the word and 
watch your minicomputer do its 
stuff. 
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10 CLEAR1500:DEFINTA,C,N,R,V,W,Z:DEFSTRD,P:DIMD(7) ,P(50,50) 

20 CLS:PRINTCHR$(23) :PRINT"W ORDSEARCH"; 

30 PRINT6192,"THIS WILL HELP YOU SOLVE ONE OF THE MOST TIME CONSUMING PUZZLES EV 

ER INVENTED, WORDSEARCH. yOURJOB, TO FIND THE HIDDEN WORDS, IS TAKEN OVER 
BY THE TRS-80." 
40 FORZ=0TO7:READD(Z) :NEXTZ:PRINT:PRINT 
50 PRINT'DO YOU WANT INSTRUCTIONS (Y/N) "; : INPUTA$ : IFLEFTS (AS ,1) ="Y"THENGOTO970EL 

SEIFLEFTS(A$,1)O"N"THEN50 
60 DATA"NORTHWEST", "NORTH ", "NORTHEAST" , "EAST ", "SOUTHEAST" , "SOUTH "," 

SOUTHWEST", "WEST 
70 CLS:PRINT"VERSION DESCRIPTION" : PRINT 

80 PRINT" 1 MAXIMUM 14 BY 14 PUZZLE SIZE WITH SCREEN PRINOUT" 
90 PRINT" 2 MAXIMUM 50 BY 50 PUZZLE SIZE NO SCREEN PRINTOUT" 
100 INPUT"PLEASE ENTER VERSION NUMBER ( 1 OR 2 )",-V 
110 IFV<1ORV>2THEN70 

120 PRINT: INPUT"PLEASE ENTER NUMBER OF ROWS IN YOUR PUZZLE" ;R: IFR<=0THENSTOP 
130 IFV=1ANDR>14THEN70 
140 INPUT"PLEASE ENTER NUMBER OF COLUMNS IN YOUR PUZZLE" ;C: IFC<=0THENSTOP 
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150 INPUT"DO VOU WANT THIS OUTPUT TO THE LINEPRINTER" ; Y$ : IFLEFT5 (YS,1) ="Y"THENY= 

1:GOSUB1110:ELSEY=0 
160 IFV=1ANDO14THEN70 
170 CLS:A=3 
180 IFV=2THEN220 

190 FORZ=lTOC:PRINT§A," " ;Z; : IFZ>9ANDO9THEN200ELSEA=A+4 :NEXTZ :GOTO210 
200 FORZ=10TOC:PRINT@A," " ; Z ; : A=A+4 :NEXTZ 
210 A=65:F0RZ=1T0R:PRINT@A,Z;:A=A+64:NEXTZ 
220 A=70:A2=832:A3=832 
230 FORR2=1TOR 
240 FORC2=1TOC 

250 PRINTS960, "PLEASE INPUT LETTER AT ROW" ;R2; "COLUMN" ;C2; 
260 GOSUB950:P(R2,C2)=P(0,0) 

270 IFV=1THENPRINT@A,P(0,0) ; ELSEPRINT@A2,P (0, 0) ; 
280 A=A+4:A2=A2+1:NEXTC2:IFV=2THENGOSUB940 
290 A= ( ( R2+1 ) *6 4 ) +6 : A2=832 : IFV=2THENGOSUB960 
300 NEXTR2 

310 PRINTS960, "INPUT Y FOR CORRECTIONS ELSE INPUT N";:GOSUB950 
320 IFP(0,0)="N"THEN480 

330 PRINT6960, "INPUT 00 FOR ROW NUMBER TO STOP CORRECTIONS ROUTINE" ;: GOSUB940 
340 R2=0:C2=0 

350 A3=960:GOSUB960:PRINTg960, "INPUT ROW NUMBER OF LETTER IN ERROR"; 
360 GOSUB950:R2=VAL(P(0,0)):GOSUB950:R2=10*R2+VAL(P(0,0)) 
370 IFR2<=0THEN480 
380 IFR2<=RTHEN400 

390 GOSUB960:PRINT6960,"YOUR PUZZLE HAS ONLY" ;R; "ROWS" ; :GOSUB940 :GOTO350 
400 PRINT8960," INPUT COLUMN NUMBER OF LETTER IN ERROR"; 
410 GOSUB950:C2=VAL(P(0,0)) :GOSUB950:C2=10*C2+VAL(P(0,0) ) 
420 IFC2<=CANDC2>=1THEN440 

430 GOSUB960:PRINT6960,"YOUR PUZZLE HAS ONLY" ;C; "COLUMNS" ; :GOSUB940 :GOTO400 
440 A=(R2*64)+((C2*4)+2) 
450 PRINT8960, "INPUT CORRECT LETTER FOR ROW" ;R2; "COLUMN" ;C2; :GOSUB950 : P(R2 ,C2) =P 

(0,0) 
460 IFV=2THEN350 

470 FORZZ=lT05:FORZ=lT05:PRINTeA," "; : PRINT@A,F(0,0> ; :NEXTZ:NEXTZZ:GOTO350 
480 PRINT@960,"HOW MANY LETTERS ARE IN THE WORD TO SEARCH FOR" ; :GOSUB950:W2=VAL( 

P(0,0)) :GOSUB950:W2=10*W2+VAL(P(0,0)) :A3=832 
490 IFW2<=0THENGOSUB1200ELSBIFV=2THENGOSUB960 
500 IFW2>RANDW2>2THENPRINT§960,"WORD IS BIGGER THAN PUZZLE, TRY AGAIN. (USE TWO 

DIGITS, 02 = 2)";:FORI=1TO800:NEXT:PRINT@960,CHRS(30):GOTO480 
510 A3=960:GOSUB960:PRINT@960, "PLEASE INPUT YOUR" ;W2; "LETTER WORD"; 
520 A=993:A2=832 
530 FORW=lTOW2 
540 GOSUB950:P(0,W)=P(0,0> 

550 IFV=2THENPRINTSA2,P(0,W) ;ELSEPRIHT8A,P(3,W) ; 
560 A=A+1:A2=A2+1 
570 NEXTW 

580 IFY=1THENFORW=1TOW2:LPRINTP(0,W);:NEXTW:LPRINTTAB(20)," " 
590 N=0 

600 FORR4=lTOR 
610 FORC4=lTOC 

620 IFP(R4,C4)OP(0,1)THEN880ELSEZ=0 
630 W3=0:W4=2:R7=-1:C7=-1 
640 R5=R4:C5=C4 
650 IFR7<0THENR5=R5-1 
660 IFC7<0THENC5=C5-1 
670 IFR7>0THENR5=R5+1 
680 IFC7>0THENC5=C5+1 
6 90 IFR5<=0ORC5<=0ORR5>RORC5>CTHBN770 
700 IFP(R5,C5)OP(0,W4)THEN770 
710 W4=W4+1 
720 IFW4>W2THEN740 
730 W3=1:GOTO650 
740 PRINTe960,"WORD STARTS AT ROW" ;R4; "COLUMN" ,-C4; "TO THE " ;D(Z) ; :GOSUB940 : IFY=1 

THENLPRINT"WORD STARTS AT ROW" ,-R4; "COLUMN" ;C4; "TO THE ";D(Z); 
750 N=N+1:W4=2:W3=0 
760 IFLEFT$(D(Z),1)="W"THEN880 
770 IFW3O1THEN790 
780 W4=2:W3=0 
790 IFZ=0THENC7=0:GOTO870 
800 ONZGOTO810,820,830,840,850,860,880 
810 C7=1:GOTO870 
820 R7=0:GOTO870 
830 R7=1:GOTO870 
840 C7=0:GOTO870 
850 C7=-1:GOTO870 
860 R7=0 

870 Z=Z+1:GOTO640 
880 NEXTC4 
890 NEXTR4 

900 A3=960:GOSUB960:IFNO0THEN920 

910 PRINTS960,"WORD IS NOT IN PUZZLE" ; :GOSUB940 :GOTO480 
920 PRINT6960,"WORD APPEARED" ;N; "TIMES IN PUZZLE" ;: GOSUB940 : IFY=1THENLPRINT"W0RD 

APPEARED" ;N; "TIMES IN THE PUZZLE"; 
930 GOTO480 

940 FORZ2=1TO1000:NEXTZ2:RETURN 
950 P(0,0)="":P(0,0)=INKEY$:IFP(0,0)=""THEN950ELSERETURN 
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960 FORA4=A3TOA3+62:PRINTSA4," "; :NEXTA4: RETURN 

970 CLS:PRINT"THIS PUZZLE HAS TWO VERSIONS. VERSION #1 ALLOWS YOU TO INPUT A PU 

ZZLE MATRIX HAVING A MAXIMUM OF 14 ROWS AND 14 COLUMNS. tHIS VERSION WILL 

PRINT THE MATRIX ON THE SCREEN AS YOU PUT IN THE 
980 PRINT" LETTERS. VERSION #2 ALLOWS A MAXIMUM OF 50 ROWS AND 50 COLUMNS BUT 

WILL NOT PRINT THE MATRIX ON THE SCREEN. "; 
990 PRINT'AFTER YOU CHOOSE WHICH VERSION YOU WANT TO USE, YOU WILL BE ASKED HO 

W MANY ROWS AND THEN HOW MANY COLUMNS YOU WANT IN YOUR PUZZLE. BE SURE NO 

TTO CHOOSE MORE THAN 14 FOR EITHER IF "; 
1000 PRINT"YOU CHOSE VERSION #1 AND NOT MORE THAN 50 IF YOU CHOSE VERSION #2. 
NOW ENTER YOUR PUZZLE. DON'T WORRY IF YOU MAKE ANY ERRORS AS YOU WI 

LL BE GIVENA CHANCE TO CORRECT THEM. WHEN YOU ARE " ; 
1010 PRINT-DONE CORRECTING ERRORS OR IF YOU DO NOT HAVE ANY, ENTER 00 WHEN ASKE 

D 'INPUT ROW NUMBEROF LETTER IN ERROR'." 
1020 PRINT:PRINT°HIT ENTER TO CONTINUE." 
1030 A$=INKEY$:IFAS=""THEN1030 
1040 CLS:PRINT:PRINT"NOW THE COMPUTER NEEDS TO KNOW HOW MANY LETTERS ARE IN THE 

WORD IT IS GOING TO LOOK FOR. ***THIS NUMBER MUST BE INPUT AS A TWO DIGIT 

NUMBER (02 FOR 2)*** " ; 
1050 PRINT"NEXT YOU INPUT THE WORD YOU WANT TO FIND AND THE COMPUTER WILL FIND I 

T FOR YOU AND TELL YOU WHERE "; 
1060 PRINT'ITIS AND HOW MANY TIMES IT APPEARS IN THE PUZZLE. INPUTTING 00 WHE 

N IT ASKS 'HOW MANY LETTERS TO SEARCH FOR' WILL BRING YOU TO AN OPTION TO E 

ND PROGRAM OR DO ANOTHER PUZZLE." 
1070 PRINT:PRINT"HAVE FUN1" 
1080 PRINT:PRINT"HIT ENTER TO CONTINUE." 
1090 A$»INKEY$:IFA$=""THEN1090 
1100 GOTO60 
1110 A=PEEK(14312):IFA=255THENPRINT"YOU NEED TO TURN YOUR PRINTER ON ! " :FORI=1T04 

20:NEXTI:GOTO150 
1120 IFA=223PRINT"YOU NEED PAPERI " :FORI=1TO420 :NEXTI :GOTO150 
1130 IFAO63THENPRINT"S0METHING IS WRONG WITH YOUR LINE PRINTER" :FORI=1TO420 :NEX 

TI:GOTO150 
1140 FORXl=lTOR:FORXZ=lTOC 
1150 LPRINTP(X1,X2);" "; 
1160 NEXT X2 
1170 LPRINTCHR$(13) 
1180 NEXTX1 
1190 CLS:RUN 

1200 CLS:PRINT:PRINT"DO YOU WANT TO:" 
1210 PRINT" 1.) DO ANOTHER PUZZLE." 
1220 PRINT"2.) END PROGRAM." 
1230 INPUTA: IFA=1THENRUN 
1240 IFAO2THENGOTO1200 
1250 END 



INVISIBLE MAZE: by Dennis Nau 



Place your maze blockers in 
secrecy and watch your oppo- 
nent bounce off the walls as he 
works his way through the maze. 
A good choice for married 
couples. 




20 DEFINTA-P:DEFSTRQ-Z:DIMA(195),W(3),X(2),Y(3) 

30 C=0:D=1:E=2:Q=CHR$(14) :R=CHR$(15) :S=CHR$(9) :T=CHR$(8) 

40 U=CHR$(91):V=CHRS(10):W(0)=CHR$(94):W(1)=CHR$(93) 
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50 W(2)=U:W(3)=CHRS(92):Z3=" " :Z4="Y":Z5="N" 

60 READY(0),Y(1),Y(2),Y(3) 

70 CLS:FORG=DTO195:A(G)=C:NEXT:N=C:K=100 

80 PRINT'HOW MANY BLOCKERS WILL YOU USE ( MAX";K;")" 

90 IFO<=CORO>KTHEN80ELSEPRINT" 

100 IFLEN(X(B))>CTHEN125 

110 INPUT'WHAT IS 1ST PLAYERS HAME",-X(D) :PRINT"" 

120 INPUT'WHAT IS 2ND PLAYERS NAME";X(E) 

125 GOSUB370 



130 PRINTgC, X(D) 
140 B=D:GOSUB400 
150 PRINTgC, X(E) 



PLACE YOUR BLOCKERS, "X(E);" NO PEEKING"; 
:B=B:GOSUB370 

PLACE YOUR BLOCKERS, "X(D);" NO PEEKING"; 

160 GOSIIB 400 :N=D:CLS:PRINT"WHO WILL GO FIRST" 

170 PRINT"1 = ";X(D);" 2 = ";X(E) ; : INPUTG: PRINT"" 

180 INPUT'DO YOU WANT TRAIL MARKINGS (Y/N)";Z2 

190 IFLEFT$(Z2,D)=Z4THENZ2=Z4 

200 IFLEFTS(Z2,D)=Z5THENZ2=Z5 

210 IFZ2OZ4ANDZ2OZ5THEN180 

220 IFG=DTHEN260 

230 B=E 

240 CLS:PRINTgC,X(B);"'S TURN"; 

250 F=203:GOSUB380:GOSUB620:GOSUB600:GOTO270 

260 B=D:GOTO240 

270 Z=INKEYS 

280 PRINTQ;Q;R; 

290 IFZ=""THEN270 

300 L=P-D 

310 GOSUB700 

320 IFF>195THENF=203:GOTO270 

330 GOSUB620:GOSUB600 

340 IFZ2=Z5THENPRINTgL,Z3; 

350 IFB=DANDA(F)=EORB=EANDA(F)=DORA(F)=3THEN750 

360 PRINT8P,W(M) ;:GOSUB600:GOTO27 

370 CLS 

380 PRINTg65,Y(D) :FORG=DT013:PRINTTAB(l)Y(E) :NEXT 

390 PRINTg961,Y(3);:RETURN 

400 F=188:K=O:GOSUB620:GOSUB600:Z1=LEFT$(X(B) ,D) 

410 Z=INKEYS 

420 PRINTQ;Q;R; 

430 IFZ=""THEN410 

440 GOSUB700:GOSUB620:GOSUB600 

450 IFZ=" "ANDK<OTHEN650 

460 IFZOZ1THEN410 

470 IFB=DANDA(F)OCOR(B=EANDA(F)=EORA(F)=3)THEN410 

480 IFF=188ORF=8THEN410 

490 IFB=EANDA(F)=DTHENA(F)=3ELSEA(F)=E 

500 IFB=DTHENA(F)=D 

510 PRINT@P,Z1;:K=K-D:IFK=CRETURN 

520 PRINT8C,X(B);K;" BLOCKERS LEFT "; 

530 GOSUB600:GOTO410 

540 IFF-15=-7ANDN=DTHEN790 

550 IFF-15<=CTHENRETURNELSEF=F-15:M=E:RETURN 

560 IFF+15>19 5THENRETURNELSEF=F+15 : H=3 : RETURN 

570 IFINT((F-D)/15)=(F-D)/150RF-D<DRETURN 

580 F=F-D:M=D: RETURN 

590 IFINT(F/15)=F/150RF+D>195THENRETURNBLSEF=F+D:M=C:RETURN 

600 G=15360+P:H=VARPTR(G) 

610 P0KE16416,PEEK(H) :POKE16417 ,PEEK(H+D) :RETURN 

620 G1=F/15:G=INT(F/15):H=G*15 

630 IFGI=GTHENI=5ELSEI=D 

640 J=F-H:P=((G+E)*64)+((J*4)-I) :RETURN 

650 IFA(F)=CTHEN410 

660 IFB=DANDA(F)=DTHENA(F)=C 

670 IFB=EANDA(F)=ETHENA(F)=C 

680 IFB=EANDA(F)=3THENA(F)=D 

690 PRINT8P-D,Z3;:GOSUB600:K=K+D:GOTO520 

700 IFZ=UGOSUB540 

710 IFZ=VGOSUB560 

720 IFZ=TGOSUB570 

730 IFZ=SGOSUB590 

7 40 RETURN 

750 FORG=DTO10 

760 FORH=DTO15:PRINT@P-D,Y(0);:NEXTH 

770 FORH=DT015:PRINTgP-D,Z3,-:NEXTH:NEXTG 

7 80 IFB=DTHEN230ELSE260 

790 CLS:PRINTCHR$(23):FRINT8528,X(B);" WINS" :FORG=DTO1500:NEXT 

800 PRINTgC, "PRESS ENTER TO REVIEW HAZE" 

810 PRINT"1 = ";X(D);"'S BLOCKERS" 

820 PRINT"2 = ";X{E);"'S BLOCKERS" 

830 PRINT"3 = BOTH PLAYERS BLOCKERS" : INPUTH:GOSUB370 

840 FORO=DTO195:IFA(O)=CTHEN860 

850 F=O:GOSUB620:PRINTgP, RIGHTS (STR$(A(0) ) ,D) ; 

860 NEXT 

870 PRINTgC, "";:INPUT"LIKE TO PLAY AGAIN (Y/N)";Z2 

880 IF LEFTS (Z2,D)=Z4THEN70 

890 DATACONTLETCONT 

900 DATADEFDEFDEFDEFDEFDEFDEFDEFDEFDEFDEFDEFDEFDEFDEFDEFDEFDEFDEFDEFDEFDEFDEFDEF 
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DEFDEFDEFDEFTAB ( USR [ USRTAB (DEFDEFDEFDEFDEFDEFDEFDEFDEFDEFDEFDBFDEPDEFDFFDEF 
DEFDEFDEFDEFDEFDEFDEFDEFDEFDEFDEFDEF 

910 DATAUSINGERRDEFERRDEFERRDBFERRDEFBRRDEFERRDEFERRDEFERRDEFERRDEFERRDEFERRDEFE 
RRDEFERRDEFERRDEFERRUSING 

920 DATASETSETSETSETSETSETSETSETSETSETSETSETSETSETSETSETSETSETSBTSETSETSBTSETSET 
SETSETSETSETIFUSRiUSRIFSETSETSETSETSETSETSETSETSETSETSETSETSBTSETSETSETSETS 
ETSETSETSETSETSETSETSETSETSETSET 



SUPER MAZE: by James Haines 



More amazing fun with the 
maze premise. You determine 
the dimensions, and the TRS-80 
draws the maze. May not be for 
the lazy. Use your arrow keys 
quickly; the guard is fast ap- 
proaching! 




1 
i 
110 



120 
121 



130 
14 

145 
150 

180 
190 
200 
210 

215 

230 
235 

250 
2B0 

2B5 
286 
290 

310 
312 
320 

330 
350 
360 



CLEAR 100:DEFINT K,E,F,H,D,W,V,L,Q,Y:KK=1:KH=4 
CLS:H=-1: PRINT 6 87,"*** SUPER-MAZE ***":PRINT:PRINT 

INPUT-WIDTH, LENGTH";B,C:IF BOINT(B) OR COINT(C) PRINT" INTEGERS ONLY, p LEA s 
E.":GOTO 110 ELSE IF B<2 PRINT"TOO NARROW .": GOTO 110 ELSE IF B>16 PRINT'TOO 
WIDE.":GOTO 110 ELSE IF C<2 PRINT'TOO SHORT. ":GOTO 110 ELSE IF C>14 print" 
TOO LONG.":GOTO110 *-kihi 

RANDOM:DIH AR(B*C*2) :D=INT( (B*C)/240*3+.5) : IF D=0 THEN D=l 

INPUT'DIFFICULTY FACTOR (1- EASIEST, 10-HARDEST) "; AA: IF AA<1 OR AA>10 OR AA< 

>INT(AA) PRINT"ENTER INTEGERS BETWEEN 1 AND 10 ONLY, PLEASE. " :GOTO 121 E r?E 

AB=((10-AA)*(56/(B*C)+.75)*21.6+180)*B*C/224*1.5:CLS:IF (B*C)<19 THEN 145 

PRINT g 527,"ALLOW";D;"MINUTE(S) FOR MAZE GENERATION." 

FOR N=l TO 7:FOR P=l TO 100:NEXT P :PRINT 6 533," ";:FOR P=l TO 100:NEXT p.p 

RINT e 532,D;:NEXT N:CLS 
PRINT 8 537, "GENERATING MAZE" 

DIM A{B-1,C-1),A1(7),QW(4):A1(1)=1:A1(3)=-1:A1(4)=1:A1(6)=-1:V=RND(B)-1.A(V 

0)=1:E=V:FORN=0TO4:OW(N)=N+1:NBXT l ' 

Kl=(RND{4)-2)*2 

FOR K=KK TO KH:Kl=Kl+2 : IF Kl-8 THEN K1=0 

JK=E+A1(K1):KL=F+A1(K1+1): IF JK<0 OR KL<0 OR JKXB-1) OR KLXC-1) THEN 2B6 
IF A(JK,KL)<>0 THEN 286 ELSE IF W THEN 280 
JK=E+A1(K1)*2: KL=F+A1 (Kl+1) *2: IF JK<0 OR KL<0 OR JKXB-1) OR KLXC-1) THEN 

230 ELSE IF A(JK,KL)=1 THEN 286 
IF A1(K1)=0 THEN L=1:L1=0 ELSE L=0:L1=1 
JK=E+A1(K1)+L: KL=F+A1 (Kl+1) +L1 : IF JKXB-1) OR KLXC-1) THEN 250 ELSE if a( 

JK,KL)=1 THEN 286 " * l 

JK=JK-2*L: KL=KL-2*L1: IF JK<0 OR KL<0 THEN 280 ELSE IF A(JK,KL)=1 THEN 286 
E=E+A1(K1):F=F+A1(K1+1) :IF W THEN A(E,F) =-l:AT=AT+2:AR{AT) =E:AR(AT+1) =p.p-p_ 

A1(K1):F=F-A1(K1+1) ELSEA(E,F)=1 
GOTO 180 

NEXT K: IF WW THEN 800 ELSE WW=1 
FOR W=0 TO 1: FOR H1=0 TO C-l: FOR H=0 TO B-l: IF W THEN 310 ELSE IF A(h hi) 

=1 THEN E=H:D=1:F=H1:GOTO 180 ELSE 312 ' ' 

IF A(H,H1)=0 THEN A(H,H1) =-2 :E=H : F=H1 : AT=0: AR ( 0) =H: AR (1) =H1 : GOTO 180 
NEXT H,H1,W 
CLS: FOR N=0 TO (8*(B-1)) STEP 8:IF (N/8)=V THEN 330 ELSE FOR M=N TO N+7-SET 

(M,0):NEXT M M 

NEXT N 

PRINT § 832,:SET (1,0): IF A(0,0)=-2 THEN A9=l 

FOR N=0 TO C-l:FOR M=0 TO 2:SET( 0,N*3+M) :NEXT: FOR M=0 TO B-1:IF N=(C-1) THEN 
440 ELSE D=A(M,N)+A(M,N+1):IF A(M,N+l)=-2 THEN 440 ELSE IF ABS{D)=2 OR D=- 

3 THEN 440 ELSE IF A9=l THEN A9=0:GOTO 440 ELSE FOR R=0 TO 7:SET(M*8+R ( N + 
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440 IF M=(B-1) THEN 460 ELSE IF A(M,N) =A(M+1,N) OR (A(M,N) +A(M+1 ,N) ) =-3 THEN 470 

460 FOR R=0 TO 3: IF H=B-1 THEN 461 ELSE IF N=0 AND A(M+l,N)=-2 THEN 462 

461 SET(M*8+7,N*3-R+3) 

462 NEXT R 

470 NEXT M,N: S=0 

500 FOR N=0 TO B-l: IF A(N,C-1)=1 THEN S=S+1 

510 NEXT N: M=RND(S) :S=0 

550 FOR N=0 TO (B-l): IF A(N,C-1>=1 THEN S=S+1 

560 IF S=H THEN M1=N:M=0:SET (N*8+7,C*3> :GOTO 590 

570 FOR R=l TO 8: SET(N*8-1+R,C*3) :NEXT R 

590 NEXT N:X=V*8-f4:Y=2 

591 IF AA=10 THEN FORN=0 TO C-1:FORM=0 TO B-1:A(M,N> =3:NEXTM,N 

595 PRIOT§960™TIME B LIHIT: ■ ; INT( (AB/12) -INTIAB/720) *60) ; " SECONDS. PRESS 'B' 

TO BEGIN."; 
600 AS=INKEY$:IP A$<>"B" THEN 600 ELSE SET(V*8+4,2) 
606 GOSUB 4000 

610 X5=X5+1.3:IF X5>AB AND FL=0 GOSUB 3000 „„,,,„ „ - T „„.„ e T _ „c 

615 PRINT«999,INT(X5/720);:PRINTei012,INT(X5/12)-INT(X5/720)*60;:A$=INKEY$:IF AS 

="" AND FL GOTO 4200 ELSE IF AS="" THEN 610 
618 E=ASC(AS):IF BOB AND E<>9 AND EO10 AND E<>91 THEN X5=X5+2:IF FL THEN 4200 

ELSE 610 
620 ON (E-7) GOTO 640,650,660 
630 IF Y<3 THEN 710 ELSE K=0:K1=-2:GOTO 670 
640 IF X<5 THEN 710 ELSE K=-5:K1=0:GOTO 670 
650 K=3:K1=0:GOTO 670 
660 K=0:K1=1 
670 IF POINT(X+K,Y+Kl) THEN 710 ELSE X5=X5+4 , 

690 RESET(X,Y):xix+SGN(K)*8:Y=Y+SGN(Kl)*3:SET(X,Y):X2=X2+l: IF (Y/3XC THEN A(X/ 

8,Y/3)=0 

691 IF (X4+E)=101 OR (X4+E)=17 THEN X3=X3+1 

700 X4=E:PRINT6966,X2;:PRINT8982,X3;: IF Y>C«3 THEN 2000 ELSE IF FL THEN 4200 E 

LSE 610 
710 IF FL THEN 4200 ELSE GOSUB 3000 
*7 9 fl POTO fi 1 & 

800 IF AY-AT THEN AY=0:GOTO 312 ELSE AY=AY+2:E=AR(AY) :F=AR(AY+1) :GOTO 180 

2000 FOR N=l TO 500:NEXT:CLS:PRINT 8 512, CHRS (23) ; "CONGRATULATIONS!! YOU MADE IT 

2010 INPUT"WANT TO TRY ANOTHER" ; AS :AS=LEFT$ (AS, 1) : IF A$<>"Y" AND AS<>"N" PRINT:P 
RINT"ANSWER 'YES' OR 'NO' ONLY, PLEASE ." :PRINT:GOTO 2010 ELSE IF AS = "Y 
" RUN ELSE PRINT:PRINT"O.K. I'LL SIGN OFF...":FOR N=l TO 1000 :NEXT:CLS: END 

3000 FOR N=l TO 5:PRINT 6 960,STRINGS(63, " ") ; :FORP=1TO200:NEXT:PRINT@960 ,"INTRU 
DER ALERT. CALL OUT THE GUARD1 "; : FOR P=l TO 200:NEXT P,N 

3005 X5=X5+156:FLAG=l:PRINTe960,"SEAL OFF THE EXIT! »;STRING$(42, " ") ; :F0RP=1T055 
0:NEXT:FOR N=0 TO 7:SET(M1*8+N,C*3) :FOR M=l TO 20:NEXT H,N 

3006 PRINT 8 960, "GUARD APPROACHING ENTRANCE ...",-: FOR N=l TO 500 :NEXT: FORN=l TO 
5:K=RND(4)-1:K1=RND(4)-1:XB=QW(K):QW(K)=QW(K1):QW(K1)=XB:NEXT 

3010 GN=GN+1:K=0:K1=0:XB=V*8+4:YB=2:IF AA=10 THEN 3020 ELSE FOR N=0 TO C-l:FORM= 

TO B-l:A(M,N)=0:NEXTM,N:X5=X5+60*B*C/224 
3020 PRINT6960, "GUARD ENTERING MAZE... "j:FOR N=l TO 500!NEXT=SET(XB, 0) :F 

OR N=l TO 200:NEXT:RESET(XB,0):SET(XB,YB):A(XB/8,YB/3)=1: IF XB=X AND YB=Y 

THEN SET(X,0) :GOTO 4340 
3030 GOSUB 4000:FOR N=V*8+7 TO V»8 STEP -1:SET(N,0) :FOR M=l TO 20:NEXT H,N:RETUR 

4000 PRINT8960, "MOVES:", "ERRORS", "TIME: MINUTES SECONDS" ; :PRINT@966 ,X2 

;:PRINT6982,X3;:RETURN 
4200 FOR QX=0 TO 4:ON QW(QX) GOTO 4206,4210,4220,4230,4250 
4206 IF YB<3 THEN 4242 ELSE K=0:K1=-2:GOTO 4240 
4210 IF XB<5 THEN 4242 ELSE K=-5:K1=0:GOTO 4240 
4220 K=3:K1=0:GOTO 4240 

4240 L3=INT(XB/8+SGN(K>): L4=INT (YB/3+SGN (Kl) ) : IF POINT(XB+K,YB+Kl) THEN 4242 E 
LSE IF L3XB-1) OR L4XC-1) THEN 4242 ELSE L=A(L3,L4) : IF L-l AND ZZ THEN 4 
260 ELSE IF L=0 THEN 4300 

4242 NEXT QX 

4243 GOTO 4203 

4250 ZZ=ZZ+1:IF ZZ>1 THEN 4315 ELSE 4200 
4260 A(XB/8,YB/3)=2:GOTO 4310 

4310 IF X UBisGN«r*8)=X AND (YB+SGN (Kl) *3> -Y THEN 4340 ELSE RESET(XB,YB) :XB=XB+S 
GN(K)*8:YB=YB+SGN(K1)«3:SET(XB,YB):X5=X5+(QX+1)*2+ZZ*9:ZZ=0:GOTO 610 

4315 IF XBOV*8+4 OR YB<>2 THEN 4350 

4320 PRINT8960,"MUST HAVE BEEN A FALSE ALARM. .." ;STRING$ (32 , " ")j:FOR N=V*8 TO V 
*8+7:RESET(N,0):FOR M=l TO 20:NEXT M, N: RESET (XB, YB) : FOR N=0TO6 :RESET(M1*8+N 
,C*3):FOR M=l TO 20:NEXT M,N:FORN=l TO 2000:NEXT:GOSUB 4000 

4330 X5=X5+60:AB=120*720+AB:FL=0:GOTO 610 

4340 RESET(XB,YB):SET(XB+SGN(K)*4,YB+SGN(K1)*1.5):PRINT«960,"AHAU I CAUGHT YOU! 
";STRINGS(44," ");:FOR N=l TO 5000:NEXT:CLS:END 

4350 PRINTS960,STRINGS(63," "),-: PRINTS960, "GUARD NUMBER ";GN;" IS LOST. DISINTEG 
RATE HIM.";:FOR N=l TO 1500:NEXT:RESET(XB,YB) :PRINT6960, "CALL OUT GUARD NUM 
BER";GN+1;".";STRINGS(20," ") ; : FOR N=l TO 1500:NEXT 

4360 FOR N=V*8 TO V*8+7:RESET(N,0) :FOR M=l TO 20:NEXT M,N:GOSUB 3006:GOTO 610 
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OHARE: by W.D. MacDonald 

You guessed it. With this pro- 
gram, you can enjoy all the 
romance and excitement of being 
a real life air traffic controller at 
the busiest airport in the world. 
Excellent graphics depict a hec- 
tic radar display complete with 
transponder idents for all com- 
mercial traffic in the pattern. All 
you have to do is direct the air- 
craft to the runway as they ap- 
pear from several points of the 
compass. An outstanding simula- 
tion with six levels of difficulty. 
Keep the Rolaids handy for this 
one. 




620 PRINT8399,"2 
630 PRINT6527,"3 
640 PRINT@655,"4 
650 PRINT8783,"5 
660 PRINT8911, "6 



1 CLEAR100:RANDOM:DEFINT I,X,Y:DEFSNG Q,R:DIH FS(21) ,PS% (21) ,XX(21) , X(25),Y(25 

) ,H%(21) ,HN%(21) ,DR$(21) ,S%(21) ,DX1 (21) ,DY! (21) ,XI1 (25) ,YII (25) 

2 REM W.D. MACDONALD 

19 KD4=RND(4) :IF WD%=2 THEN19 ELSE600 

20 POKE 15902, 248:POKE 15901, 224:POKE 15903, 240 : PRINT8606 ,CHR$ (90+WD%) ;: POKE 158 

08, 49: POKE 15872,56 :POKE15936, 48: POKE15871 ,48:POKE15935 ,48: POKE15999 ,48:POK 

E 16347,50:POKE16350,55:POKE16353,48:POKE15387,48:POKE15390,57:POKE15393,48 

: PRINT60 ,CD$;VLS ;: RETURN 
600 CLS:PRINTei53, "LEVEL OF PLAY" 

610 PRINT6271,"1 SENIOR SUPERVISING AIR CONTROLLER" 
JOURNEYMAN AIR CONTROLLER" 
ADVANCED APPRENTICE CONTROLLER" 
SECOND YEAR APPRENTICE CONTROLLER" 
FIRST YEAR APPRENTICE CONTROLLER" 
CONTROLLER RECRUIT" 
670 PRINT@0,"";:INPUT"LEVEL OF PLAY";LV%:IF LV%>6 THEN LV%=6 
680 IF LV4<1 THEN LV%=1 
1000 F$(1)="A":F$(2)="B":F$(3)="D":F$(4)="E":F$(5)="F":F$(6)="G":F$(7)="J":F$(8) 

="K":F$(9)="M":F$(10)="N":FS(11)="P":F$(12)="Q":F$(13)="T":F$(14)="U":F$(15 

)="V":F$(16)="W":F$(17)="X":F$(18)="Y":F$(19)="Z":F$(20)="I":SC*=10000 
1020 FOR I=1TO20:S%(I)=180:NEXT 
1025 FOR I=1TO20STEP4:H%(I)=000:HN%(I)=H%(I) :H% (1+1) =270 :HN* (1+1) =H% (1+1) :H%(I+2 

)=180:HN%(I+2)=H%(I+2) :H% (1+3) =090 :HN% (1+3) =H% (1+3) :NEXTI 
1030 FOR I=3T021 STEP4:X(I) =(10+2*LV%) *I+RND(20) :XI 1 (I) =X(I) :Y(I) =10-RND(4) :YI ! ( 

I)=Y(I) ::NEXTI 
1040 FOR I=1TO21STEP4:X(I)=120-RND(15)-(13+2*LV%)*(I) :XII(I)=X(I) :Y(I) =40-RND(10 

) :YI1 (I)=Y(I) :NEXTI 
1050 FOR I=2T021STEP4:X(I)=25-RND(15):XI! (I)=X(I) :Y( I) =38-RND(8) -(8+LV%*2) *I:YI ! 

(I)=Y(I) :NEXTI 
1060 FOR I=4T021STEP4:Y(I)=(8+LV%*2)*I-RND(8) :YI! (I)=Y(I) :X( I) =105-RND( 20) :XII (I 

)=X(I) :NEXTI 
1065 DT%=0 : Q=. 001333 :R=. 000666 : TP ! =6. 2830 :TS%=360:SF!=1:YF1=. 583 :WN%=1:TF% =25 :CF 

!=.017453 3:SX%=6:WT%=120:FV%=1:FF%=45:TU%=2:TH%=3:SF%=64:GOSUB2000 
1070 FOR I=WN%TO20STEPWN% 

1075 B$=INKEY$:IF B$="" THEN1080 ELSE GOSUB3000 
1080 IF X(I)>SX% AND X(I)<WT% AND Y(I)>FV% AND Y(I)<FF% THEN1090 ELSE NEXT I:GOT 

01092 

1090 B$=INKEYS:IFB$="" THEN 1091 ELSE GOSUB3000 

1091 QT%=QT%+1:XX(QT%)=I:PS%(XX(QT%))=(INT((X(I)-TU%)/TU%)+SF%*INT((Y(I)+TH%)/TH 
») ) :NEXTI 

1092 CLS:PRINT@8,FS(J) ; "H";HN% (J) ; "S";S% ( J) ; : PRINT§40 , "SCORE: " ;SC%; :GOSUB20: IF 
QT%=0 THEN 1093 ELSE FOR Z%=WN%TOQT% : IF P0INT(X (XX (Z%) ) ,Y (XX (Z%) ) ) THEN GOS 
UB 6000 ELSE SET(X(XX(Z%)) ,Y(XX(Z%)>) :PRINT§PS% (XX(Z4) ) ,FS(XX(Z%)) ;H%(XX(Z% 
)) ;:NEXTZ%:GOSUB20 

1093 QTS=0 

1120 GOSUB2000:SC%=SC*-DT*:GOTO2020 
2000 DT*=8 
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2004 ET*=DT%+ET%:IF ET%>720 THEN 2005 ELSE 2010 

2005 WD%=RND(4) : IF WD%=2 THEN 2005 ELSE ET%=0: PRINT6470 , " WARNING II WIND DIRECT 
ION UPDATE" 

2010 OT%=NT%: RETURN 

2020 CT%=0:FOR I=WN%TO20 

2021 BS=INKEYS:IF B$="" THEN 2023 ELSE GOSUB 3000 

2023 IF ABS(H%(I)-HN%(I))<23 THEN H% (I) =HN% (I) :GOTO2026 

2024 IF DR$(I)="R" THEN H* (I) =H% ( I) -3*DT% : IF H%(I)<0 THEN Hi ( I] =H% (I) +360 :GOT02 
026 

2025 IF DR$(I)="L" THEN H% (I) =H% (I) +3*DT%: IF H%(I)>=360 THEN Hi ( I) =H% (I) -360 

2026 B$=INKEY$: IF B$="" THEN2060 ELSE GOSUB3000 
2060 ON WD% GOTO 2065,2065,2070,2075 

2065 IF POINT(61,15+CT%) THEN GOTO2080 ELSE FOR T=1T02:SET(61,15+CT%) :NEXTT:RESE 

T(61,15+CT4) :GOTO2080 
2070 IF POINT(40+CT%*2,26) THEN GOTO2080 ELSE FOR T=1TO2:SET(40+CT%*2,26) :NEXTT 

:RESET(40+CT**2,26) :GOTO2080 
2075 IF POINT(82-CTi*2,26> THEN GOTO2080 ELSE FOR T=1T02:SET(82-CT4*2,26) :NEXTT: 

RESET(82-CT%*2,26) 

2080 B$=INKEYS:IF B$="" THEN 2081 ELSE GOSDB 3000 

2081 CT%=CT%+3:IF CT%>9 THEN CT%=0 

2100 XII (I)=XIl(I)+(S%(I))*DT%*Q*COS(Hi(I)*CF!) :X ( I) =XI I (I) : YI I (I) =YI I (I) - (Si (I) 

)*DTi*R*SIN(Hi(I)*CFl) :Y(I)=YI1(I) 
2105 B$=INKEY?:IF B$="" THEN2110 ELSE GOSUB3000 
2110 NEXTI:GOTO107 
3000 K$=B$:B$="":IF K?="C" THEN CM5="" :HM$="" :Ni=0:CD$="" :VL$="" : J=0 : Kt=0:K$="" : 

RETURN 

3002 IF K$="R" THEN K4=1:CDS=K$:HM$="" :K$="" :DR$ (J) ="R" :N%=0: PRINTS0 , " ":P 
RINT@0,CD$:RETURN 

3003 IF K$="L" THENK%=l:CD$=K$:HM$="":K$="":DR$(J)="L":Ni=0:PRINTe0," ":PR 
INT@0,CD$:RETURN 

3004 IF K$="S" THEN K%=2: CD$=KS: K$="" :N%=0 : SM$="" : PRINTS0 , " " :PRINTS0,CD$: 
RETURN 

3006 ON K4 GOTO 3050,3060 

3010 CM$=K$:K$-="":PRINT@0,CM$; 

3030 FOR L=WN%TO20:IF F$(L)=CM$ THEN3040 ELSE NEXTL: PRINTS0, "FLIGHT NOT IN THIS 

SECTOR"; :CMS="":Ni=0:RETURN 
3040 J=L:PRINT80,STRING$(25," "):PRINTe8 ,F$(J) ; "H";HNi ( J) ,- "S";Si (J) ; :CD$="" :VL$ 

="": RETURN 
3050 H$(N%)=K$:HM$=HM?+H$(Ni) :N%=Ni+l:K$="":PRINTg0, STRINGS! 7," ") ; : PRINTS0,CD$ 

;HM$; 

3052 IF N%>=3 THEN HN% ( J) =VAL(HM$) : VL$=STR$ (HN% ( J) ) :HMS="" :N%=0: IF HNi(J)=H%(J) 
THEN H%(J)=H%(J)+360 

3053 RETURN 

3060 S$(N%)=KS:SM$=SM?+S$(Ni) : N4=N4+1 :K$="" :PRINT80, STRINGS! 7," ") ; : PRINT60 ,CDS 
,- SM$ ; 

3062 IF N%>=3 THEN S% ( J) =VAL(RIGHT$ (SMS, 3) ) : VL$=STRS (Si ( J) ) :SM$="" :Ni=0 

3063 IF S%(J)>180 THEN S% ( J) =180 

3064 IF S4(J)<100 THEN Si (J) =100 

3065 RETURN 

6000 IF (X(XX(Zi))=58 OR X(XX(Z%))=59 OR X(XX(Z%))=60 OR X(XX(Z%))=61 OR X(XX(Zi 
)]=62 OR X(XX(Z%))=63) AND (Y(XX(Z4) ) =25 OR Y (XX (Z%) ) =26) THEN GOSUB6120 EL 
SE GOSUB 6200 

6001 RETURN 

6020 XI! (XX(Zi))=000:YI!(XX(Z4))=000:Si(XX(Z4))=0:RETURN 

6120 IF X(XX(Z%)]=61 AND Hi (XX (Z%) ) =27 AND WD%=1 THEN GOSUB 6280:RETURN 

6130 IF Y(XX(Z%))=26 AND Hi (XX (Z») ) =000 AND WD%=3 THEN GOSUB 6280:RETURN 

6140 IF Y(XX(Z%))=26 AND H% (XX (Z%) ) =180 AND WD%=4 THEN GOSUB 6280 ELSE GOSUB615 
: RETURN 

6141 RETURN 

6150 PRINT8470, F?(XX(Z%)); " HISSED RUNWAY- LANDING ABORTED",- :H% (XX(Z%) ) =H% (XX( 

Z4))+135:IF H%(XX(Z%) )>360 THEN Hi (XX(Z%) ) =H% (XX(Z%) ) -360 :HN% (XX(Z%) ) =H% (XX 

(Z%)) :DR$(XX(Zi))="R":SC4=SCi-500:RETURN 
6200 CLS:PRINT@416,"A MID-AIR COLLISION HAS OCCURRED" :SC%=SC%-5000 
6210 FOR L%=1T025:IF L%=XX(Z%) THEN NEXT L% 
6220 IF X(L%)=X(XX(Z%)) AND Y(L4) =Y(XX(Zi) ) THEN PRINT@480,P$(Li) ; " AND ";FS(XX( 

Zi)); " ARE GOING DOWN. "; :XI1 (L%) =0: YI I (L%) =0:S% (L%) =0 
6230 NEXT Li 
6240 GOSUB6020 
6260 RETURN 
6280 IF Si(XX(Z4))<120 THEN PRINT6470, FS (XX(Z%) ) ; " LANDED SHORT OF RUNWAY-SPEED 

TOO LOW! I " J : GOSUB6020: SC%=SC%-2500 :RETURN 
6290 IF Si(XX(Z%))>150 THEN PRINT6470, FS(XX(Z%)); " OVERSHOT RUNWAY-SPEED TOO H 

IGH I! " ; :GOSUB6020 : SC%=SC%-2500 :RETURN 
6300 TL%=TLi+l:PRINT@470, F$ (XX(Z%) ) ; " LANDED SAFELY. " ,• : PRINT6487 ."TOTAL LANDE 

D IS ";TLi;:SCi=SC%+100:IF TL%=20 THEN PRINTS534, "GAME OVER-FINAL SCORE: "; 

SC%; ELSE GOSUB6020:RETURN 
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FOUR IN A ROW: by Mikal Pedersen 



Match wits with your TRS-80 
in an effort to get four X's or O's 
in a row. Vertical, horizontal 
and diagonal matching allowed 
with optional time limit on 
moves available. Several levels of 
play and usual computer gloat- 
ing included. 



2 POKE16553,255:CLEAR40 

10 DEFINTA,B,C,D,F,I,J,K,L,M,R,P,S,T,V:DEFSTRN:DEFSNGY 

30 DIM RM(7),FM(7),FS(7),AP(7,6),AV(7,6),MN(7),MH(7),ML(7),T(32),B(32),S(7) :PA=0 

100 GOSUB1000:GOSUB2000 

140 GOSUB25000 

180 IFPSW=1ANDP1=1THEN370 

191 IFPSW=2ANDP2=1THEN370 

210 GOSUB3000 

230 ROW=LR:COL=LC 

250 GOSUB4000 

260 IFPSW=1ANDMH(COL)=30GOSUB29000 

261 IFPSW=2ANDML(COL)=-30GOSUB29000 
290 GOSUB26000 

320 IFPSW=1THENPSW=2ELSEPSW=1 

340 IFYW<>1THENHV=MV+1 

351 PRINT8368,"MOVE: ";HV; :GOTO 180 

370 PRINT9960, "PLAYER *";PSW;", THE COMPUTER, IS NOW TAKING HIS TURN " 

390 GOSUB5000 

400 IFPSW=1ANDD1O0THENGOS0B7000 
410 IFPSW=2ANDD2O0THENGOSUB7000 
470 GOSUB26000 
480 GOTO320 

1000 CLS:FORI=15360TO15423:POKEI,143:POKEI+320,188:POKEI+960,188:NEXTI:FORI=1536 
0TO156 84STEP64 : POKEI , 191 : POKEI+63 ,191 :NEXTI 

1031 F0RI=1T032:READT(I) :NEXTI 

1032 DATA 156,140,168,140,172,168,128,168,168,140,172,128,168,168,144,168 
1034 DATA 128,156,140,148,128,128,156,140,148,156,140,148,148,128,128,148 

1036 F0RI=1T032:READB(I) :NEXTI 

1037 DATA 151,129,170,176,186,170,176,186,170,131,169,128,170,170,130,174 
1039 DATA 128,151,131,149,128,128,151,131,148,181,176,149,138,154,154,128 

1050 FORI=1TO16:POKEI+15500,T(I) :POKEI+15564,B(I) :NEXTI:F0RI=1T016:P0KEI+15518,T 

(1+16) :POKEI+15582,B(I+16) :NEXTI:RETURN 
2000 FORI=1TO7:FORJ=1TO6:AP(I,J)=0:NEXTJ,I 
2030 F0RJ=1T06:F0RI=1T07:READAV(I,J) :NEXTI,J 
2040 DATA 2,3,4,6,4,3,2,2,3,4,8,4,3,2,2,5,8,10,8,5,2,3,5,9,11,9,5,3,3,5,7,9,7,5, 

3,3,4,5,7,5,4,3 
2090 FORI=1TO7:MN(I)=1:NEXTI:P1=0:Y1=0:Y2=0:TZ=0 

2120 PRINTS453, "ENTER NAME OF FIRST PLAYERCC FOR COMPUTER) ";: INPUT Nl 
2130 IFN1=""GOTO2120 : ELSEN1=LEFT$ (Nl , 12) 
2140 IFN1="C"THENP1=1ELSE2150 

2142 I=0:GOSUB2400 

2143 D1=0:INPUTN$ 

2145 IFLEFTS(NS,1)="B"GOTO2150 

2146 IFLEFT$(N$,1)="I"THEND1=1:GOTO2150 

2147 IFLEFT$(N$,1)="A"THEND1=2:ELSEG0T0214 2 

2150 P2=0:PRINT6517, "ENTER NAME OF SECOND PLAYERCC FOR COMPUTER) ";: INPUTN2 
2160 IFN2=""GOTO2150:ELSEN2=LEFTS(N2,12) 
2170 IFN2="C"THENP2=1ELSE2190 
217 2 I=64:GOSUB2400 
2173 D2=0:INPUTN$ 

2175 IFLEFT$(N$,1)="B"THEN2190 

2176 IFLEFT$(N$,1)="I"THEND2=1:GOTO2190 

217 7 IFLEFT$ (N$ , 1 ) =" A"THEND2=2 : ELSEG0T0217 2 

2190 PSW=1:MV=1 

2210 PRINT6650,"DO YOU WANT PLAYING PIECES ERASED AFTER "; 

2211 PRINT6714,"EACH MOVE THAT HAS BEEN PLAYED (Y OR N) ";: INPUT N 
2214 IFLEFT$(N,1)="N"ORN="Y"THEN2220ELSE2210 

2220 IFLEFT$(N,1)="Y"THENVSW=2ELSEVSW=1 
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2350 RESTORE:YT=0 

2351 IFP1=1ANDP2=1THENRETURN 

2360 PRINT8650,"DO YOU WISH TO SET A TIME LIMIT FOR EACH "; 

2361 PRINT6714,"MOVE <Y OR N) " ; :PRINTS731,""; : I 
NPUT N 

2364 IFLEFT$(N,1)="Y"ORLEFT$(N,1)="N"THEN2366ELSE2360 

2366 IFLEFT$(N,1)="Y"THEN2368 

2367 YT=0:RETURN 

236B PRINT8842, "ENTER NUMBER OF SECONDS (00.5 TO 100.0) THAT"; 

2369 PRINT8906,"YOU WISH TO LIMIT EACH MOVE"; 

2370 INPUTYT 

2371 YT=INT(YT*10)/10 

2372 IFYT<.5ORYT>100THEN2370 
2380 RETURN 

2400 PRINT6517+I, "ENTER 'B','1' OR AN 'A' " ; : PRINT8453+I, "ARE YOU A BEGINNER, INT 

ERMEDIATE OR ADVANCED PLAYER"; 
2410 RETURN 

3000 GOSUB27000 

3001 IFPSW=1THENP=560ELSEP=752 

3002 IFPSW=2ANDP1=1THENP=560 

3003 PRINT8P,"TIMER(PLAYER";PSW;")"; 

3004 IFPSW=1THENP=631ELSEP=823 

3005 IFPSW=2ANDP1=1THENP=631 

3006 PRINT8P, "SECONDS"; 

3007 P=P-7 

3008 YSEC=0.1:YW=0 

3009 I=0:NF="»4«.#" 

3010 PRINT8960,"IT'S YOUR TURN, "; 
3020 IFPSW=1PRINTN1;BLSEPRINTN2; 

3030 PRINT ", ENTER COLUMN NUMBER ? "; 

3039 PRINTSP,"";: PRINT USING NF;YSEC; 

3040 A$=INKEYS 

3042 1=1+1 

3043 IFIO1THEN3050 

3044 YSEC=YSEC+.l 

3045 PRINT8P," -,";: PRINT USING NF;YSEC; 

3046 1=0 

3047 IFYT=0THEN3050 

3048 IFYSEC<YTTHEN3050 

3049 YW=1:GOTO320 

3050 IFA$=""GOTO3040 

3060 IFASC(A$)=13GOTO3040ELSELC=VAL(A$) 

3080 IFLC=0GOTO140 

3100 IFLC<0ORLO7THEN3010 

3110 IFMN(LCX7THENLR=MN(LC)ELSE3010 

3111 IFPSW=1THENY1=Y1+YSECELSEY2=Y2+YSEC 
3160 RETURN 

4000 MH(COL)=0:ML(COL)=0 

4035 IFROW>60RROW<lRETURN 

4050 GOSUB11000:GOSUB12000:GOSUB13000:RETURN 

5000 GOSUB 6000 

5010 GOSUB 6100 

5015 IF SWO0THENLC=TW:LR=MN(LC) :GOTO29000 

5020 IFSS=0THEN5050 

5030 LC=TV:LR=MN(LC) : IFSS=1GOTO470ELSEGOSUB6200 

5040 RETURN 

5050 GOSUB6300 

5060 IFSS=0THEN5080 

5070 LC=TV:LR=MN(LC) : RETURN 

5080 IFRND(100)<35GOTO5140 

5090 GOSUB6400 

5100 IFSSO0GOTO5070 

5110 GOSUB6500 

5120 IFSSO0GOTO5070 

5130 GOTO5200 

5140 GOSUB6500 

5150 IFSSO0GOTO5070 

5160 GOSUB6400 

5200 IFMV=1GOSUB6600:RETURN 

5210 GOSUB6700:GOSUB6800:RETURN 

6000 FORK=lT07:COL=K:ROW=MN(K) :GOSUB4000:NEXTK:RETURN 

6100 SW=0:SS=0:FORK=1TO7 

6110 IFMN(K)>6THEN6170 

6120 LC=K:LR=MN(LC) 

6130 IFPSW=1ANDML(K)=-30THENSS=SS+1:TV=K:GOTO6170 

6140 IFPSW=2ANDMH(K)=30THENSS=SS+1:TV=K:GOTO6170 

6150 IFPSW=1ANDMH(K)=30THENSW=SW+1:TW=K 

6160 IFPSW= 2ANDML ( K ) =- 30THENSW=SW+1 : TW=K 

6170 NEXTK:RETURN 

6200 IFRND(100)>25RETURN 

6230 PRINT8833,"MY CONGRATULATIONS ON AN EXCELLENT MOVE,"; : PRINT8896 , " I RESIGN 

GRACIOUSLY TO A WORTHY OPPONENT" ;: FORI=1TO1000 :NEXTI :GOTO29018 
6300 SS=0:FORK=1TO7:IFMN(K)>6THEN6330 
6310 IFPSW=1ANDMH(K)=20ANDML(K)=-20THENSS=1:TV=K 
6320 IFPSW=2ANDML(K)=-20ANDMH(K)=20THENSS=1:TV=K 
6330 NEXTK: RETURN 
6400 SS=0:FORK=1TO7:IFMN(K)>6THEN6430 
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6410 IFPSW=1ANDMH(K)=20THEN6440 

6420 IFPSW=2ANDML(K)=-20THEN6440 

6430 NEXTK:RETURN 

6440 SS=SS+1:IFSS=1THENTV=K:GOTO6430 

6450 IFAV(K,MN(K))>AV(TV,MN(TV))THENTV=K 

6460 GOTO6430 

6500 SS=0:FORK=1TO7:IFMN(K)>6THEN6530 

6510 IFPSW=1ANDML(K)=--20THEN6540 

6520 IFPSW=2ANDMH(K)=20THEN6540 

6530 NEXTK:RETURN 

6540 SS=SS+1:IFSS=1THENTV=K:GOTO6430 

6550 IFAV(K,MN(K))>AV(TV,MN{TV))THENTV=K 

6560 GOTO6530 

6600 RANDOM 

6610 I=INT(RND(7) ) :LC=I:LR=MN(LC) 

6620 IFK1THEN6600ELSERETURN 

6700 F0RI=1T07:IFMN(I)<7RETURNELSENEXTI 

6710 GOSUB27000 

6800 F0RI=1T07:IFMN(I)>6THENNEXTI:ELSELC=I:LR=MN(LC) 

6810 FORI=1TO7:IFMN(I)>6THEN6830 

6820 IF AV(LC,LR)<AV{I,MN(I))THENLC=I:LR=MN(LC) 

6830 NEXTI: RETURN 

7000 I=RND{6) :IFMV<30RTZ=1RETURN 

7001 IFI>4GOTO 7010:ELSEPRINT@960," 

";:ON I GOTO 7002,7003,7004,7005 

7002 PRINT6960,"HMMMMM, COLUMN" ;LC; "IS A POSSIBILITY. ";:GOTO7010 

7003 PRINT@960,"I AH THINKING ABOUT";LC; ". "; :GOTO7010 

7004 PRINT§960,"COLUMN",-LC;"DOESN'T SEEM TOO BAD. " ; :GOTO7010 

7005 PRINT8960,"I AM EXAMINING COLUMN" ;LC; "FOR A POSSIBLE MOVE.";:GOTO 7010 
7010 TE=LC:FORI=0TO7:RM(I)=0:FM(I)=0:FS(I)=0:NEXTI 

7020 FORI=1TO7:IFMN(I)<7THENRM(0)=RM(0)+1:RM(RM(0))=I 
7030 NEXTI :IFRM(0)=1THENTZ=1 
7040 IFRM(0)=1RETURN 

7045 IF PSW=1ANDD1=1THENGOSUB9000:RETURN 

7046 IF PSW=2ANDD2=1THENGOSUB9000:RETURN 
7050 FORJ=1TORM(0) :TC=RM(J) :TR=MN(TC) 

7060 MN{TC)=MN(TC)+1:IFPSW=1THENPSW=2:AP(TC,TR)=10:ELSEPSW=1:AP(TC,TR)=-10 

7065 GOSUB6000 

7070 GOSUB6100 

7080 IFSWO0THENRM(J)=0:GOTO7110 

7090 IFSS>1THEN7130 

7100 IFSS=1THENFM(0)=FM(0)+1:FM(FM(0))=TC:FS(FM(0))=TV 

7110 MN(TC)=MN(TC)-1:AP(TC,TR)=0:IFPSW=1THENPSW=2ELSEPSW=1 

7120 NEXTJ:GOTO7150 

7130 MN(TC)=MN(TC)-1:AP(TC,TR)=0:IFPSK=1THENPSW=2ELSEPSW=1 

7140 LC=TC:LR=MN(LC) : RETURN 

7150 RM(0)=0:FORI=1TO7:IFRM(I>O0THENRM(0)=RM(0)+1:RM{RM(0))=RM(I) 

7160 NBXTIUF RM(0) >2GOTO7170ELSEI=INT(RND(100) ) 

7165 IFK10PRINT8960, "THERE AREN'T TWO MANY CHOICES I HAVE LEFT " ; :F0RI = 1T01 

000: NEXTI 
7170 IF RM(0)=0THEN LC=TE:LR=MN(LC) : RETURN 
7180 IF RM(0)=1THEN LC=RM(1) :LR=MN (LC) :RETURN 

7185 IF FM(0)=0 THEN 7190 

7186 TG=0:GOSUB80 00:IF TGO0THEN RETURN 

7187 IFRM{0)<4ORMV>28GOSUB8500 

7190 FORI=1TORM(0) :IF TE=RM(I)THEN LC=TE ;LR=MN (LC) : RETURN rELSENEXTI 

7192 TF=MN(TE) :AV(TE,TF)=0 

7195 I=INT(RND(100)) : IFI>40GOTO7200ELSEPRINT6960, "OOPS! FORGET ALL ABOUT THAT MO 

VEU ";:FORI=1TO900:NEXTI 

7200 I=INT(RND(RM(0) )) 
7210 IFK1GOTO7200 
7220 LC=RM(I) :LR=MN(LC) :RETURN 
8000 FORJ=1TOFM(0) 
8010 TC=FM(J) :TR=MN(TC) 
8020 MN(TC)=MN(TC)+1 

8030 IFPSW=1THENPSW=2:AP(TC,TR)=10:ELSEPSW=1:AP(TC,TR)=-10 
8040 TC=FS(J) :TR=MN(TC) 
8050 MN(TC)=MN(TC)+1 

8060 IFPSW=1THENPSW=2:AP(TC,TR)=10:ELSEPSW=1:AP(TC,TR)=-10 
8070 GOSUB 6000 
8080 GOSUB 6100 
8090 IF SWOB THEN 8200 
8100 AP(TC,TR)=0:MN(FSU))=MN(FS(J))-1 
8105 MN(FM(J))=MN(FM(J))-1 
8110 TC=FM(J) :TR=MN(TC) :AP(TC,TR)=0 
8130 NEXT J:TG=0:RETURN 

8200 AF(TC,TR)=0:MN(FS(J))=MN(FS(J))-1 
8205 MN(FM(J))=MN(FM(J))-1 
8210 TC=FM(J) :TR=MN{TC) :AP(TC,TR)=0 

8230 LC=FM(J) :LR=MN(LC) :TG=1 :PRINT«896, "**** GOTCHA *****"; :RETURN 
8500 IF FM(0)=RM(0) RETURN 

8510 FORI=1TORM(0) :FORK=1TOFM(0) :IFRM(I) =FH(K)THENRM(I) =0 
8520 NEXTK,I 

8530 K=1:FORI=1TORM(0):IFRM(I)=0GOTO8540:ELSERM<K)=RM(I) :K=K+1 
8540 NEXTI :RM(0)=K-1: RETURN 
9000 TE=°LC:TF=LR:MN(LC)=MN(LC)+1:IFPSW=1THENPSW=2:AP(LC,LR)=10:ELSEPSW=1:AP(LC,L 

R)=-10 
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9010 GOSUB6000:GOSUB6100:LC=TE:LR=TF 

9020 MN(LC)=MN(LC)-1:AP(LC,LR)=0:IFPSW=1THENPSW=2ELSEPSW=1 

9030 IFSW=0RETURN 

9040 K=1:FORJ=1TORM(0) : IFRM(J) =LCTHEN9050 

9045 RM(K)=RM(J) >K-K+1 

9050 NEXTJ:RM(0)=K-1 

9060 IFRM(0)=1THENLC=RM(1):LR=MN(LC) :RETURN 

9070 I=INT(RND(RM(0))) : IFK1ORI>RM(0) GOTO9070 

9080 LC=RM(I) :LR=MN(LC) :GOTO9000 

11000 IFR0W=1THENRETURN 

11020 SUM=0:SR='ROW-3 

11040 IFSR<1THENSR=1 

11050 F0RI=SRT0R0W-1:SUM=SUM+AP(C0L,I) :NEXTI 

11060 IFSUM>MH (COL) THENHH (COL) =SUM 

11070 IFSUM<HL(COL)THENML(COL)=SUH 

11080 SUM=0:SR=ROW~2 

11100 IFSR<10RROW=6THENRETURN 

11110 FORI=SRTOROW-1:SUH=SUH+AP(COL,I) :NEXTI 

11120 1FSUM>MH (COL) THENMH (COL) =SUM 

11130 IFSUM<ML(COL)THENML(COL)=SUM 

11140 RETURN 

12000 ONCOLGOTO12110, 12210, 12310, 12410, 12510, 12610, 12710 

12110 S(0)=1:S(1)=AP(2,ROW)+AP(3,ROW)+AP(4,ROW) :GOTO 12800 

12210 S(0)=2:S(1)=AP(3,ROW)+AP(4,ROW)+AP(5,ROW) 

12220 S(2)=AP(1,ROW)+AF(3,ROW)+AP(4,ROW):GOTO 12800 

12310 S(0)=3:S(1)=AP(1,ROW)+AP(2,ROW)+AP(4,ROW) 

12320 S(2)=AP(4,ROW)+AP(5,ROW)+AP(6,ROW) 

12330 S(3)=AP(2,ROW)+AP(4,ROW)+AP(5,ROW) :GOTO 12800 

12410 S(0)=4:S(1)=AP(2,ROW)+AP(3,ROW)+AP(1,ROW) 

12420 S(2)=AP(5,ROW)+AP(6,ROW)+AP(3,ROW) 

12430 S (3 ) =AP (3 ,ROW) +AP ( 5 ,ROW) +AP ( 2, ROW) 

12440 S(4)=AP(5,ROW)+AP(6,ROW)+AP(7,RON) :GOTO 12800 

12510 S(0)=3:S(1)=AP(3,ROW)+AP(4,ROW)+AP(2,ROW) 

12520 S(2)=AP(6,ROW)+AP(7,ROW)+AP(4,ROW) 

12530 S(3)=AP(4,ROW)+AP(6,ROW)+AP(3,ROW) :GOTO 12800 

12610 S(0)=2:S(1)=AP(4,ROW)+AP(5,ROW)+AP(3,ROW) 

12620 S(2)=AP(5,ROW)+AP(7,ROW)+AP(4,ROW) :GOTO 12800 

12710 S(0)=1:S(1)=AP(5,ROW)+AP(6,ROW)+AP(4,ROW) :GOTO 12800 

12800 FOR 1=1 TO S(0) 

12810 IF S(I)>MH(COL) THEN MH(COL)=S(I) 

12820 IF S(I)<ML(COL) THEN ML(COL)=S(I) 

12830 NEXT I 

12840 RETURN 

13000 ON COL GOTO 13100,13200,13300,13400,13500,13600,13700 

13100 ON ROW GOTO 14120,14220,14320,14420,14520,14620 

13200 ON ROW GOTO 15120,15220,15320,15420,15520,15620 

13300 ON ROW GOTO 16120,16220,16320,16420,16520,16620 

13400 ON ROW GOTO 17120,17220,17320,17420,17520,17620 

13500 ON ROW GOTO 18120,18220,18320,18420,18520,18620 

13600 ON ROW GOTO 19120,19220,19320,19420,19520,19620 

13700 ON ROW GOTO 20120,20220,20320,20420,20520,20620 



14120 S<0 
14220 S(0 
14320 S(0 
14420 S(0 
14520 S(0 
14620 S(0 
15120 S(0 
15220 S(0 
15230 S(2 
15320 S(0 
15330 S(2 
15340 S(3 
15420 S(0 
15430 S(2 
15440 S(3 
15520 S(0 
15530 S(2 
15620 S(0 
16120 S(0 
16220 S(0 
16230 S(2 
16240 S(3 
16320 S(0 
16330 S(2 
16340 S(3 
16350 S(4 
16360 S(5 
16420 S(0 
16430 S(2 
16440 S(3 
16450 S(4 
16460 S(5 
16520 S(0 
16530 S(2 
16540 S(3 
16620 S(0 



1:S(1)=AP(2,2)+AP(3,3)+AP(4,4) :GOTO 21000 
=l:S(l)=AP(2,3)+AP(3,4)+AP(4,5):GOTO 21000 
=1:S(1)=AP(2,4)+AP(3,5)+AP(4,6) :GOTO 21000 
=1:S(1)=AP(2,3)+AP(3,2)+AP(4,1) :GOTO 21000 
=l:S(l)=AP(2,4)+AP(3,3)+AP(4,2):GOTO 21000 
=1:S(1)=AP(2,5)+AP(3,4)+AP(4,3) :GOTO 21000 
=1:S(1)=AP(3,2)+AP(4,3)+AP(5,4) :GOTO 21000 
=2:S(1)=AP(1,1)+AP(3,3)+AP(4,4) 
=AP(3,3)+AP(4,4)+AP(5,5) :GOTO 21000 
=3:S(1)=AP(1,2)+AP(3,4)+AP(4,5) 
=AP(3,4)+AP(4,5)+AP(5,6) 
=AP(1,4)+AP(3,2)+AP(4,1) :GOTO 21000 
=3:S(1)=AP(1,3)+AP(3,5)+AP(4,6) 
=AP(1,5)+AP(3,3)+AP(4,2) 
=AP(3,3)+AP(4,2)+AP(5,1) :GOTO 21000 
=1:S(1)=AP(1,6)+AP(3,4)+AP(4,3) 
=AP(3,4)+AP(4,3)+AP(5,2) :GOTO 21000 
=1:S(1)=AP(3,5)+AP(4,4)+AP(5,3) :GOTO 21000 
=1:S(1)=AP(4,2)+AP(5,3)+AP(6,4) :GOTO 21000 
=3:S(1)=AP(2,1)+AP(4,3)+AP(5,4) 
=AP(4,3)+AP(5,4)+AP(6,5) 
=AP(1,4)+AP(2,3)+AP(4,1) :GOTO 21000 
=5:S(1)=AP(1,1)+AP(2,2)+AP(4,4) 
=AP(2,2)+AP(4,4)+AP(5,5) 
=AP(4,4)+AP(5,5)+AP(6,6) 
=AP(1,5)+AP(2,4)+AP(4,2) 
=AP(2,4)+AP(4,2)+AP(5,1) :GOTO 21000 
=5:S(1)=AP(1,2)+AP(2,3)+AP(4,5) 
=AP(2,3)+AP(4,5)+AP(5,6) 
=AP(1,6)+AP(2,5)+AP(4,3) 
=AP(2,5)+AP(4,3)+AP(5,2) 
=AP(4,3)+AP(5,2)+AP(6,1) :GOTO 21000 
=3:S(1)=AP(1,3)+AP(2,4)+AP(4,6) 
=AP(2,6)+AP(4,4)+AP(5,3) 
=AP(4,4)+AP(5,3)+AP(6,2) :GOTO 21000 
=1:S(1)=AP(4,5)+AP(5,4)+AP(6,3) :GOTO 21000 
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17128 S(0)=2:S{1)=AP(1,4)+AP(2,3)+AP(3,2) 

17130 S(2)=AP(5,2)+AP(6,3)+AP(7,4):GOTO 21000 

17220 S(0)=4:S(1)=AP(3,1)+AP(5,3)+AP(6,4) 

17230 S{2)=AP(5,3)+AP(6,4)+AP(7,5) 

17240 S(3)=AP(1,5)+AP(2,4)+AP(3,3) 

17250 S{4)=AP(2,4)+AP(3,3)+AP(5,1) :GOTO 21000 

17320 S(0)=6:S(1)=AP(2,1)+AP(3,2)+AP(5,4) 

17330 S(2)=AP(3,2)+AP(5,4)+AP(6,5) 

17340 S(3)=AP(5,4)+AP(6,5)+AP(7,6) 

17350 S{4)=AP(1,6)+AP(2,5)+AP(3,4) 

17360 S(5)=AP(2,5)+AP(3,4)+AP(5,2) 

17370 S(6)=AP(3,4)+AP(5,2)+AP(6,1) :GOTO 21000 

17 420 S(0)=6:S(1)=AP(1,1)+AP<2,2)+AP(3,3) 

17 430 S(2)=AP(2,2)+AP(3,3)+AP(5,5) 

17440 S(3)=AP(3,3)+AP(5,5)+AP{6,6) 

17 450 S(4)=AP(2,6)+AP(3,5)+AP(5,3) 

17460 S(5)=AP(3,5)+AP{5,3)+AP(6,2) 

17470 S(6)=AP(5,3)+AP(6,2)+AP(7,l):GOTO 21000 

17520 S(0)=4:S(1)=AP(1,2)+AP(2,3)+AP(3,4) 

17530 S(2)=AP(2,3)+AP(3,4)+AP(5,6) 

17540 S(3)=AP(3,6)+AP(5,4)+AP(6,3) 

17550 S(4)=AP{5,4)+AP(6,3)+AP(7,2) :GOTO 21000 

17620 S{0)=2:S(1)=AP(1,3)+AP(2,4)+AP(3,5) 

17630 S(2)=AP(5,5>+AP(6,4)+AP(7,3):GOTO 21000 

18120 S(0)=1:S(1)=AP(2,4)+AP(3,3)+AP(4,2) :GOTO 21000 

18220 S{0)=3:S(1)=AP(4,1)+AP(6,3)+AP{7,4) 

18230 S(2)=AP(2,5)+AP(3,4)+AP(4,3) 

18240 S(3)=AP(3,4)+AP(4,3)+AP(6,1):GOTO 21000 

18320 S(0)=5:S(1)=AP(3,1>+AP(4,2)+AP<6,4) 

18330 S(2)=AP(4,2)+AP(6,4)+AP(7,5) 

18340 S(3)=AP(2,6)+AP(3,5)+AP(4,4) 

18350 S(4)=AP(3,5)+AP(4,4)+AP(6,2) 

18360 S(5)=AP(4,4)+AP(6,2)+AP(7,l):GOTO 21000 

18420 S(0)=5:S(1)=AP(2,1)+AP{3,2)+AP{4,3) 

18430 S(2)=AP(3,2)+AP(4,3)+AP<6,5) 

18440 S(3)=AP(4,3)+AP{6,5)+AP(7,6) 

18450 SU)=AP(3,6)+AP(4,5)+AP(6,3) 

18460 S(5)=AP(4,5)+AP(6,3)+AP(7,2):GOTO 21000 

18520 S{0)=3:S(1)=AP(2,2)+AP(3,3)+AP(4,4) 

18530 S(2)=AP(3,3)+AP(4,4)+AP(6,6) 

18540 S(3)=AP(4,6)+AP(6,4)+AP(7,3):GOTO 21000 

18620 S(0)=1:S(1)=AP(2,3)+AP(3,4)+AP(4,5) :GOTO 21000 

19120 S(0)=1:S!1)=AP(3,4)+AP(4,3)+AP(5,2) :GOTO 21000 

19220 S(0)=2:S(1)=AP(3,5)+AP(4,4)+AP(5,3) 

19230 S(2)=AP{4,4)+AP(5,3)+AP(7,l):GOTO 21000 

19320 S{0)=3:S(1)=AP(4,1)+AP(5,2)+AP(7,4) 

19330 S(2)=AP(3,6)+AP(4,5)+AP(5,4) 

19340 S(3)=AP(4,5)+AP(5,4)+AP(7,2):GOTO 21000 

19420 S(0)=3:S(1)=AP(3,1)+AP(4,2)+AP(5,3) 

19430 S(2)=AP(4,2)+AP(5,3)+AP(7,5) 

19440 S(3)=AP(4,6)+AP(5,5)+AP(7,3) :GOTO 21000 

19520 S(0)=2:S(1)=AP(3,2)+AP(4,3)+AP(5,4) 

19530 S(2)=AP(4,3)+AP(5,4)+AP(7,6) :G0TO 21000 

19620 S(0)=1:S(1)=AP(3,3)+AP(4,4)+AP(5,5) :GOTO 21000 

20120 S(0)=1:S(1)=AP(4,4)+AP(5,3)+AP(6,2) :GOTO 21000 

20220 S(0)=1:S(1)=AP(4,5)+AP(5,4)+AP(6,3) :GOTO 21000 

20320 S(0)=1:S(1)=AP(4,6)+AP(5,5)+AP(6,4) :G0TO 21000 

20420 S(0)=1:S(1)=AP(4,1)+AP(5,2)+AP(6,3> :GOTO 21000 

20520 S(0)=1:S(1)=AP(4,2)+AP(5,3)+AP(6,4) :GOTO 21000 

20620 S(0)=1:S(1)=AP(4,3)+AP(5,4)+AP(6,5) :GOTO 21000 

21000 FOR I=1TOS(0) 

21020 IF S(I)>MH(COL) THEN MH(COL) =S(I) 

21030 IF S(I)<ML(COL) THEN ML(COL) =S ( I) 

21040 NEXT I 

21050 RETURN 

25000 CLS 

25030 11=128:12=256:13=384:14=512:15=640:16=76 8 

25040 FOR 1=153631015405 :POKEI, 140 :POKEIl+1, 140 :POKEI2+1, 140 :POKEI3+1, 140 :POKEI 4 

+1, 140 :P0KEI5+I, 140 :P0KEI6+I, 140: NEXTI 
25050 FOR I=15363T016131STEP64:POKEI,191:POKEI+6,191:POKEI+12,191:POKEI+18,191:P 

OKEI+24 , 1 91 : POKEI+30 , 191 : POKEI+36 , 191 : POKEI+42 , 191 : NEXTI 
25055 FOR I=15363TO15405STEP6:POKEI,188:NEXTI 
25060 FOR I=16131T016173STEP6:POKEI,143:NEXTI 
25080 FOR I=1T016:P0KE 15407+1, T(I) :POKE 15471+1, B(I) :NEXTI 

25090 FOR I=17T032:POKE 15518+1, T(I) :POKE 15582+1, B(I) :NEXTI 

25091 FOR I=1T016:P0KE 15663+1,140 :NEXTI 

25092 PRINTe368,"H0VE: ";MV; 

25093 IF YT=0 THEN PRINT6432 , "MAX TIME: NONE "; ELSE PRINTS432 , "MAX TIME : " ;YT; 
25120 NT="1234567" 

25130 FORI=lT07:PRINTe838+((I-l)*6) ,MID$(NT,I,1) : NEXTI 

25160 IF VSW=2 THEN 25500 

25170 FORROW=1T06:FORCOL=1T07 

25240 GOSUB 25800 

25250 NEXT COL, ROW 

25270 RETURN 

25500 ROW=RL:COL=CL 

25530 GOSUB 25800 
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25540 RETURN 

25800 IF AP(COL,ROW}=0 THEN RETURN 

25820 IF AP(COL,ROW)=10 THEN 25850 

25830 C1=191:C2=17 9:C3=191 

25840 GOTO 25860 

25850 C1=140:C2=191:C3=140 

25860 P=((COL-1)*6)+16069-((ROW-1)*128) 

25870 POKE P,Cl:POKE P+l,C2:POKE P+2,C3 

25880 RETURN 

26000 C1=140:C2=191:C3=140 

26030 IF PSW=1 THEN 26063 

26050 C1=191:C2=179:C3=191 

26063 IF VSW=1 THEN 26070 

26064 IF MV=1 THEN 26068 ELSE C4=128 

26066 P=((CL-1)*6)+16069-((RL-1)*128) 

26067 POKE P,C4:POKE P+l,C4:POKE P+2,C4 

26068 CL=LC:RL=LR 
26070 P=((LC-1}*6)+15429 
26080 FOR I=LR TO 6 

26090 POKE P,Cl:POKE P+l,C2:POKE P+2,C3 

26100 IF 1=6 GOTO 26150 

26101 TT=100 

26102 IF PSW=1ANDP1=1 THEN TT=50 

26103 IF PSW=2ANDP2=1THEN TT=50 

26104 IFP1=1ANDP2=1THENTT=25 

26105 FOR J=1T0TT:NEXT J 

26110 POKE P,128:POKE P+1,128: POKE P+2,128 

26130 P=P+128 

26140 NEXT I 

26150 MN(LC)=MN(LC)+1 

26160 IF PSW=1 THEN AP(LC,LR)=10 ELSE AP (LC, LR) =-10 

26180 RETURN 

27000 FOR I=1T07 

27001 IF MN(I)<7 THEN RETURN 

27002 NEXT I 

27010 PRINT8960,"GAME IS A TIE - NO WINNERS 

27020 FOR I=1TO2500:NEXT I 

27030 GOTO 29018 

29000 GOSUB 26000 

29006 IF PSW=1 AND P1=0 THEN 29013 

29010 IF PSW=2 AND P2=0 THEN 29013 

29011 PRINT@896,"THE COMPUTER DECLARES VICTORY WITH THE LAST MOVE" 

29012 GOTO 29018 

29013 PRINTS896, "PLAYER" ;PSW;" HAS WON WITH THE LAST HOVE MADE"; 

29018 GOSUB 29500 

29019 N=INKEY$ 

29020 IF MN(1)+MN(2)+MN(3)+MN(4)+MN(5)+MN(6)+MN(7)=49 THEN 29022 

29021 GOSUB 25800 :FORI=1TO500:NEXTI:POKEP, 128 :POKEP+l, 128 :POKEP+2, 128 :FORI=1TO10 
0:NEXTI 

29022 IF N="" THEN 29019 

29023 IF N="N" THEN 29060 

29024 GOTO 1 

29060 CLS: PRINT "GAME OVER" 

29070 END 

29500 IF VSW<>2 THEN 29600 

29510 FOR R0W=1T06 

29515 FOR C0L=1T07 

29520 GOSUB 25800 

29530 NEXT COL, ROW 

29600 IFY1O0PRINT8832, "PLAYER 1'S TIME: " ;Y1; "SECONDS' "; 

29601 IF Y2O0PRINTS865, "PLAYER 2'S TIME: ";Y2; "SECONDS" ; 

29605 PRINTS960, "ANOTHER GAME (Y OR N) ? " ; : ROW=LR: COL=L 

C:PA=PA+1 
29610 RETURN 
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THIRTEEN WAYS: by Glenn Crowther 



Luck and skill both play a role 
in this tricky game. See how 
many ways you can do it. Keep a 
calculator handy for scoring, 
too. 




10 CLS:PRINT@217,"W E L C H E" : PRINTS405 , "T THE GAM E" :PRINTS595,"T 

HIRTEEN WAY S":GOSUB630 
15 A$=CHR$<183)+CHR$(17 9)+CHR$(187) 

20 PRINTS896,"DO YOU WANT INSTRUCTIONS? (TYPE Y OR N) " ; 
30 Z$=INKEY$:IFZ$=""THEN30ELSEIFZ$="Y"THEN50 
40 IFZ$="N"THEN640ELSEPRINTg896,CHR$(31);:GOTO20 

50 CLS:PRINT8512,"WHILE A BOARD IS PRINTED ABOVE PLEASE READ THE FOLLOWING:" 
60 PRINT: PRINT"YOU WILL PLAY AGAINST THE COMPUTER IN A GAME OF BOTH LUCK" 
70 PRINT"AND SKILL. THE PLAYER TO GO FIRST WILL BE DRAWN AT" 
80 PRINT"RANDOM EACH GAME. THE ONE HAVING THE MOST POINTS AT THE" 
90 PRINT'END OF THE GAME WILL BE THE WINNER. 
100 GOSUB630:GOSUB630:GOSUB700:GOSUB620 
110 PRINT9512,CHR$(31) ;:PRINT@512, "ABOVE IS THE BOARD THE COMPUTER WILL USE DURI 

NG THE GAME." 
120 PRINT"YOUR BOARD WILL LOOK THE SAME. " ; :GOSUB630 
130 PRINT9704,"! WILL NOW WALK YOU THROUGH SOME OF THE DIFFERENT" 
140 PRINT"POSSIBILITIES THAT WILL OCCUR DURING THE GAME. " :GOSUB630 
150 PRINT"! WILL ALSO SHOW YOU HOW THE SCORING GOBS. " ; :GOSUB620 
160 PRINT6512,CHR?(31);:PRINTe512, "FIRST LET US ROLL THE DICE. " :GOSUB630 
170 POKE15732,52:POKE157 37,51:GOSUB630 

180 PRINT@57 6,"THE ROLL WAS A 4 AND A 3. NOW THE COMPUTER HAS" 
190 PRINT"THE CHOICE OF PUTTING A 4 IN ROW 3 - OR PUTTING A 3 IN ROW 4.":GOSUB63 

0:GOSUB630 
200 PRINT"LET US PUT THE 3 IN ROW 4.":GOSUB630 
210 POKE15640,51 
220 PRINT"IF YOU WILL NOW LOOK IN ROW 4 YOU WILL SEE A 3 IN COLUMN 6 . " :GOSUB630 : 

GOSUB620 
230 PRINTe512,CHRS(31);:PRINT8512, "HOWEVER, THE 3 IS REALLY IN COLUMN 3 BECAUSE" 
240 PRINT"ALL OF THE COLUMNS RUN DIAGONALLY. " :GOSUB630 

250 PRINT"THE NUMBERS AT THE TOP OF THE COLUMNS ARE FOR A GUIDE ONLY. " :GOSUB6 30 
260 PRINT"NOW LET US TAKE YOU THROUGH ANOTHER ROLL OF THE DICE. " :GOSUB630 
270 PRINT"THE ROLL WAS A 4 AND A 3 AGAIN. NOW THE COMPUTER HAS NO" 
280 PRINT"CHOICE BUT TO PUT THE 4 IN ROW 3 - LIKE THIS - LOOK ABOVE. " :GOSUB630 :G 

OSUB630 
290 POKE15576,52:GOSUB620 

300 PRINT8512,CHR5(31);:PRINTe512,"NOW LET US ROLL THEM AGAIN. " :GOSUB6 30 
310 PRINT"HOW ODD! THE ROLL WAS THE SAME. " :GOSUB6 30 

320 PRINT"WELL THE 3 IN ROW 4 IS TAKEN AND THE 4 IN ROW 3 IS TAKEN" :GOSUB6 30 
330 PRINT"SO GUESS WHAT THE COMPUTER HAS TO DO NOW????" :GOSUB630 
340 PRINT" IT MUST PUT AN 'X' SOMEWHERE ON THE BOARD. " :GOSUB6 30 

350 PRINT"NOW COMES THE TIME FOR ME TO INTRODUCE YOU TO THE SCORING. " :GOSUB6 20 
360 PRINT8512,CHR$(31) ; : PRINT8471, "60 50 50 40 30 30" 
370 PRINT"SHOWN ABOVE IS THE DIAGONAL SCORING - I.E" 
380 PRINT"THE 60 IS FOR THE l'S AND THE 30 IS FOR THE 5'S OR 6 'S . " :GOSUB630 :GOSU 

B630 
390 PRINT'A DIAGONAL WOULD LOOK LIKE THIS - LOOK ABOVE. 
400 FORA=15 432TO15772STEP68:POKEA,50:NEXT:GOSUB630:GOSUB630 
410 PRINT"THIS DIAGONAL OF 2'S WOULD GIVE YOU 50 BONUS POINTS. " :GOSUB630 
420 PRINT"BONUS? HOW DO YOU GET OTHER POINTS?" :GOSUB620 
430 PRINT@512,CHR5(31);:PRINT"GOING BACK TO THE FIRST MOVE - THE 3 WAS PUT IN RO 

W 4.":GOSUB630 
440 PRINT"THAT WOULD HAVE BEEN 3 POINTS ." :GOSUB630 

450 PRINT"NEXT WE PUT A 4 IN ROW 3 - THATS 4 MORE POINTS FOR 7.":GOSUB630 
460 PRINT'NEXT WE PUT AN 'X' SOMEWHERE - OOPSII WE HAVE NOT PUT" 
470 PRINT"THE 'X' ANYWHERE YET. " :GOSUB620 

480 PRINT§512,CHR?(31) :PRINT8512, "LET US PUT THE 'X' IN ROW 6 COLUMN 6" 
490 PRINT"SINCE THE DIAGONAL 6 ONLY GIVES US 30 POINTS." 
500 POKE15788,88:GOSUB630:GOSUB630 
510 PRINT'ANYWAY THE 'X' COUNTS NOTHING SO WE STILL HAVE 7 POINTS. " :GOSUB630 
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520 PRINT"! WILL NOW INTRODUCE YOU TO TWO MORE SCORING BONUSES. " :GOSUB630 

530 PRINT"FIRST THE COMPLETE ROW BONUS OP 50 POINTS - SEE ROW 2. " :GOSUB630 

540 B=1:FORA=15496TO15516STEP4:POKEA,B+48:B=B+1:NEXT:GOSUB630:GOSUB630 

550 PRINT"AND LAST THE 100 POINT BONUS DOWN THE MIDDLE - LOOK ABOVE. " :GOSUB6 30 

560 B=6:FORA=15448TO15768STEP64:POKEA,B+48:B=B--1:NEXT:GOSUB630:GOSUB630:GOSUB620 

570 PRINT8512,CHR$(31);:PRINT@512,"":PRINT 

580 PRINT" IF A BONUS IS REACHED BEFORE ALL THE 36 PLACES ARE MARKED" 

590 PRINT"THEN THE GAME ENDS WITH THE BONUS." : PRINT 

600 PRINT'WHEN YOU ARE READY FOR THE GAME PUSH ENTER."; 

610 Z$=INKEY$:IFZ$=""THEN610ELSE640 

620 PRINT8896,"HIT ENTER TO CONTINUE." 

625 Z$=INKEY$:IFZ$=""THEN625ELSERETURN 

630 PORW=1TO2250:NEXT:RETURN 

640 DIMP1% (2,6,6) ,V%(6,6) ,TT% (13) ,T2% (36,3) 

650 GOSUB660:GOSUB7 00:GOSUB720:GOSUB800:GOTO890 

660 RANDOM:CLS:H=0:G=0:S1=0:S2=0:RESTORE:FORA=1TO6:READAV(A) :NEXTA 

670 F0RA=1T06:F0RB=1T06:READV%(A,B) :NEXTB,A 

680 FORA=1TO12:TT%(A)=0:NEXT:TT%(13)=1 

690 FORA=1TO6:FORB=1TO6:P1%(1,A,B)=0:P1%(2,A,B)=0:NEXTB,A:RETURN 

700 PRINT84,"1 2 3 4 5 6"; :PRINT832, "T H I R T E E N WAYS"; 

710 F=67:GOSUB740:RETURN 

720 PRINT6452,"1 2 3 4 5 6";:F=515 

740 F0RA=1T06 : IFA=4ANDF<300PRINT8256 , "COMPUTER" ; : PRINT8305 , "COMPUTERS ROLL" ; 

750 IFA=4ANDF>300PRINT8704, "YOURS" ;:PRINT8753, "YOUR ROLL"; 

760 PRINT8F-3,A; 

770 F0RB=1T06 : PRINT8F , A$ ; : F=F+4 : NEXTB : F=F+44 : NEXTA: RETURN 

800 P=RND(2) :PRINT8896, "AFTER A RANDOM DRAW -" ; :ONPGOTO810 , 820 

810 PRINT" I GO FIRST";:GOTO830 

820 PRINT" YOU GO FIRST"; 

830 GOSUB1850:PRINT8896,"IF YOU EVER WANT TO REPRINT THE BOARD TYPE 99,99";:GOSU 

Bl 850: RETURN 
840 REM REPRINT BOARD 

850 C=15428:FORQ=1T02:FORA=1T06:FORB=1T06 
860 IFP1%(Q,A,B)=1POKEC+(A-1)*68+(B-1)*4,B+48:GOTO880 
870 IFPll(Q,A,B)=2POKEC+(A-l)*68+(B-l)*4,88 
880 NEXTB, A:C=15876:NEXTQ:RETURN 
890 D1=RND(6) :D2=RND(6) :H=H+1 

900 PRINT@480,"THE SCORE IS ME",-S1;" Y0U";S2; 
910 ONPGOTO920,930 

920 POKE15732,D1+48:POKE15737,D2+48:POKE1617 9,32:POKE16183,32:GOTO940 
930 POKE1617 9,D1+48:POKE16183,D2+48:POKB15732,32:POKE15737,32:GOTO950 
940 GOSUB1110:GOTO1090 
950 IFD1=D2IFP1%(2,D1,D2)=0THEN1040 
960 IFP14 (2,D1,D2)=0ANDP1%(2,D2,D1)=0PRINT8896,"DO YOU WANT TO PUT (1) A";D2;"IN 

ROW";D1;"OR (2) A";D1;"IN ROW";D2; :PRINTCHRS (31) ; : INPUTZ:ELSE990 
970 IFZ=99CLS:GOSUB700:GOSUB720:GOSUB840:POKE1617 9,D1+48:FOKE16183,D2+48:GOTO960 
980 IFZ<10RZ>2PRINT8896,"YOU DID NOT TYPE 1 OR 2" ; :GOSUB1850:GOTO960:ELSE1050 
990 IFP1»(2,D1,D2)=0THEN1040ELSEIFP1%(2,D2,D1)=0THEND=D1:D1=D2:D2=D:GOTO1040 
1000 PRINT8896,"YOU HAVE NO MOVE - WHAT (ROW, NUMBER) WILL YOU PUT AN 'X'";:PRINT 

CHR5(31),-:INPUTY,Z:IFY=99CLS:GOSUB700:GOSUB720:GOSUB840:POKE1617 9,D1+48:POK 

E16183,D2+48:GOTO1000 
1010 IFY<10RY>60RZ<10RZ>6PRINT8896,"YOU MUST TYPE ONLY NUMBERS FROM 1 TO 6";:GOS 

UB1850:GOTO1000 
1020 IFPl%(2,Y,Z)O0PRINTe896,"YOU HAVE ALREADY USED ROW" ;Y; "NUMBER" ; Z ; ;GOSUB185 

0:GOTO1000 
1030 P1%(2,Y,Z)=2:D1=Y:D2=Z:GOTO1070 

1040 PRINT8896,"YOU MUST PUT A";D2;"IN ROW" ;D1; :GOSUB1850:GOTO1060 
1050 IFZ=2THEND=D1:D1=D2:D2=D 
1060 P1%(2,D1,D2)=1:S2=S2+D2 
1070 IFPl%(2,Dl,D2)=lPOKE15876+(Dl-l)*68+(D2-l)*4,D2+48ELSEPOKE15876+(Dl-l)*68+( 

D2-l)*4,88 
1080 GOTO1620 
1090 IFPl%(l,Dl,D2)=lPOKE15428+(Dl-l)»68+(D2-l)*4,D2+48ELSEPOKE15428+(Dl-l)*68+( 

D2-l)*4,88 
1100 GOTO1620 
1110 REM COMPUTER MOVES 
1120 IFD1OD2THEN1140 

1130 IFP1%(1,D1,D2)=0THEN1180ELSE1200 
1140 IFP1%(1,D1,D2)=0THEN1160 
1150 IFP1%(1,D2,D1)=0THEN1170ELSE1200 
1160 IFP1%(1,D2,D1)=0THEN1190ELSE1180 
1170 D=D1:D1=D2:D2=D 

1180 PRINT8896,"! HAVE TO PUT A";D2;"IN ROW";Dl; :GOSUB1850:GOTO1240 
1190 PRINT8896,"! AM THINKING OF MY MOVE" ,- : GOSUB1850:GOTO1220 
1200 PRINT8896,"! AM THINKING OF WHERE I WILL PUT AN 'X' "; :PRINTCHR$ (31) ; :GOSUBl 

27 
1210 PRINT8896,"I WILL PUT AN 'X' IN ROW" ;D1; "NUMBER" ;D2; :GOSUB1850 :GOTO1260 
1220 IFV% (D1,D2)<V%(D2,D1)THEND=D1:D1=D2:D2=D 
1230 PRINT8896,"! WILL PUT A";D2;"IN ROW" ;D1; :GOSUB1850 
1240 Pl%(l,Dl,D2)=l:GOSUB 1420 :S1=S1+D2:TT* (Dl) =TT% (Dl) +1:TT% (D2+6) =TTS (D2+6) +1 

: IFD1+D2=7THENTT% (13) =TT* ( 13) +1 
1250 RETURN 

1260 P1»(1,D1,D2)=2:RETURN 
127 REM "X" ONE NUMBER OUT 

1280 C=0 : F0RA=1T06 : F0RB=1T06 : IFP1% ( 1 , A, B) >0THEN1360 
1290 C=C+l:T2%(C,l)=TT%(A)+TT%(B+6) 
1300 IFA+BO7THEN1330 
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1310 T2%(C,1)=T2%(C,1)+TT%(13) 

1320 IFTT%(13)>TT%(A)ANDTT»{13)>TT%{B+6)THENT2%(C,1)=T2%(C,1)+TT%(13) :GOTO1350 

1330 IFTT% ( A) <TT% (B+6) THENT2% (C, 1) =T2% (C, 1 ) +TT% (B+6) :GOTO1350 

1340 T2%(C,1)=T2%(C,1)+TT%(A> 

1350 T2%(C,2)=A:T2%(C,3)=B 

1360 NEXTB,A:IFC=1THEN1410 

1365 P3=C 

1370 P3=INT(P3/2) :IFP3<1THEN1410 

137 5 F0RP1=1T0P3 : F0RP2=P1T0P4-P3STEPP3 : P5=P2 

1380 F0RD=1T03:T(D)=T2%(P2+P3,D) :NEXTD 

1385 IFT(1)=>T2%{P5,1)THEN1400 

1390 F0RD=1T03:T2%(P5+P3,D)=T2%(P5,D) :NEXTD 

1395 P5=P5-P3:IFP5=>1THEN1385 

1400 F0RD=1T03:T2%{P5+P3,D)=T(D) :NEXTD,P2,P1:GOTO1370 

1410 01=T2%(1,2) :D2=T2%(1,3) :GOSUB1570:RETURN 

1420 REM ADJUST THE VALUE TABLE WITH PLUS VALUES 

1430 C=0:FORA=1TO6:IFP1%(1,A,D2)=2THEN1460 

1440 IFP1*(1,A,D2)<>1THENC=C+1 

1450 NEXTA: IFO1GOSUB1540ELSERETURN 

1460 C=0:FORA=1TO6:IFP1%(1,D1,A)=2THEN1490 

1470 IFP1%(1,D1,A)<>1THENC=C+1 

1480 NEXTA: IFO1GOSUB1550ELSERETURN 

1490 IFD1+D207RETURN 

1500 B=1:C=6:D=0:FORA=1TO6:IFP1% (1,B,C) =2RETURN 

1510 IFP1%(1,B,C)<>1THEND=D+1 

1520 B=B+1:C=C-1:NEXTA:IFD>1GOSUB1560ELSERETURN 

1530 RETURN 

1540 F0RA=1T06:V%(A,D2)=V%(A,D2)+INT(AV(D2)/C) :NEXTA:RETURN 

1550 FORA=1TO6:V%(D1,A)=V%(D1,A)+INT(50/C) :NBXTA:RETURN 

1560 B=1:C=6:FORA=1TO6:V%(B,C)=V%(B,C)+INT(100/D) :B=B+1:C=C-1: NEXTA: RETURN 

1570 REM ADJUST THE VALUE TABLE WITH MINUS VALUES 

1580 F0RA=1T06:V%(D1,A)=V%(D1,A)-1:NEXTA 

1590 F0RA=1T06:V%(A,D2)=V%(A,D2)-1:NEXTA 

1600 IFD1+D207RETURN 

1610 B=1:C=6:F0RA=1T06:V%(B,C)=V%(B,C)-1:B=B+1:C=C-1:NEXTA:RETURN 

1620 REM CHECK FOR END OF THE GAME 

1630 IFH=72THEN17 80 

1640 E=0:C=0:FORA=1TO6:FORB=1TO6:IFP1%(P,A,B)=1THENC=C+1 

1650 NEXTB: IFC=6THENE=50 :G=1 :GOTO1670 

1660 C=0:NEXTA 

167 C=0 : F0RA=1T06 : F0RB=1T06 : IFP14 (P, B, A) =1THENC=C+1 

1680 NEXTB: IFC=6THENG=1:ONAGOTO1700, 1710, 1710, 1720, 1730, 1730 

1690 C=0:NBXTA:GOTO1740 

1700 E=E+60:GOTO1740 

1710 E=E+50:GOTO17 40 

1720 E=E+40:GOTO17 40 

1730 B=E+30 

1740 B=1:C=6:D=0:FORA=1TO6:IFP1%(P,B,C)=1THEND=D+1 

1750 B=B+1:C=C-1:NEXTA:IFD=6THENG=1:E=E+100 

1760 IFGO1THENIFP=1THBNP=2:GOTO890:ELSEP=1:GOTO890 

1770 IFP=1THENS1=S1+EELSES2=S2+E 

1780 PRINT@475,"THE FINAL SCORE IS ME" ;S1; "YOU";S2; 

1790 PRINT@896,"THE GAME IS OVER AND" ; : IFS1>S2THENPRINT" I WIN" ;ELSEIFS2>S1THENP 

RINT" YOU WIN";ELSEPRINT" IT IS A TIE"; 
1800 PRINTCHR$(31);:GOSUB1850 
1810 PRINT6896,"DO YOU WANT TO PLAY ANOTHER GAME (Y OR N) ";: PRINTCHR$ (31) ;: INPUT 

ZS 
1820 IFZS="Y"THEN650 

1830 IFZ$="N"PRINT@896, "THANKS FOR THE GAME! 1 1 "; :GOSUBl 850: CLS: END 
1840 GOTO1810 

1850 PRINTCHR$ (31) ; :FORW=1TO1500 :NEXTW: RETURN 
1860 DATA60,50,50,40,30,30 

1870 DATA18, 16, 16, 14, 13, 29, 18, 16, 16, 14, 29, 13 
1880 DATA18, 16, 16, 30, 13, 13, 18, 16, 32, 14, 13, 13 
1890 DATA18, 32, 16, 14, 13, 13, 34, 16, 16, 14, 13, 13 
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SIEGE OF CAMELOT: by San ford Deutsch 



Outstanding graphics and a 
zany plot make Camelot worth 
your programming effort. Heros 
and villains, knights and 
bowmen respond to your key- 
board commands, while you fol- 
low their antics in detail on the 
monitor. Beware of Modred; he's 
attacking again, and your provi- 
sions in the castle are getting 
low. 







m 







50 CLS:CLEAR 125 

60 PRINT CHR$(23):PRINTS 332, "SIEGE OF CAMELOT" 

70 FOR I=1TO2000:NEXT 

80 DB$="0":DK$="*":AB$="X":AK$="#":OA=852:OD=418:OE=350 

90 AL=0:DL=0:J=0:L=0 

100 CLS:PRINT@ 91,CHR$ (189) ; :PRINTS 92, CHRS (190) ;: PRINTS 93 .STRING? (6 ,CHR$ (184) ) 

110 PRINTS 99,CHR$ (186) ;: PRINTS 100, CHRS (188) ;: PRINTS 101 , CHRS (149) ; 

120 PRINTS 155,STRING$(2,CHRS(191));:PRINTS 157 ,CHRS (189) ; 

130 PRINTS 158,STRINGS(5,CHRS(191));:PRINTS 163 ,CHR$ (187) j 

140 PRINTS 164,CHR$(191);:PRINTS 165, CHRS (149) ; 

150 PRINTS 219,STRINGS(10,CHR$(179));:PRINTS 229 , CHRS (177) ; 

160 PRINTS 219,STRING$(5,CHRS(179));:PRINT8 225 .STRINGS (4, CHRS (179) ) ; 

170 PRINTS 229,CHRS(177) ;:PRINT6 192, STRINGS (27 , CHRS (176) ) ; 

180 PRINTS" 230,STRING$(26,CHRS(176)); 

190 IF NG=1 THEN PRINTS 224 ,CHRS (17 9) ; :GOTO 1080 

200 PRINTS OE,DB$;:PRINTS 354 ,DB$; : FOR I=1TO750:NEXT 

210 PRINTS OA,AB$;:FOR I=lTO500:NEXT:OA=OA+4 

220 T=T+1:IF T=7 THEN 230 ELSE 210 

230 T=0:FOR I=1TO100:NEXT:PRINTS 924, AK$; 

240 FOR I=1TO500:NEXT:PRINTS 932, AKS; : FOR I=1TO1000:NEXT 

250 PRINTS 354," ";:PRINT8 OD,DBS;:FOR I=1TO750:NEXT 

260 PRINTS 354,"?";:FOR I=1TO1250 :NEXT:PRINTS 354," ";:FOR I=1TO250:NEXT 

270 PRINTS 354,"i";:FOR I=1T035 :NEXT: PRINTS 354," ";:FOR I=1TO20:NEXT 

280 T=T+1:IF T=10 THEN 290 ELSE 270 

290 T=0 

300 PRINTS OD," ";:FOR I=1TO20:NEXT:OD=OD-1: PRINTS OD.DBSi 

310 FOR I=1TO100:NEXT:T=T+1:IF T=2 THEN 320 ELSE 300 

320 T=0 

330 PRINTS OD," ";:FOR I=lTO20:NEXT:OD=OD-64 : PRINTS OD,DBS; 

340 FOR I=1TO100:NEXT:T=T+1:IF T=2 THEN 350 ELSE 330 

350 FOR I=1TO500:NEXT 

360 PRINTS OD-64,CHR$(140) ;:FOR I=1TO500:NEXT:PRINTS OD," "; 

370 OD=OD-64:PRINT@ OD,DB$;:FOR I=1TO500:NEXT:T=0 

380 PRINTS 12, "MODRED IS ATTACKING 111"; 

390 FOR I=1TO750:NEXT:PRINT8 12,STRING?(42,CHRS (128) ) ; : FOR I=1TO100 :NEXT 

400 T=T+1:IF T=3 THEN 410 ELSE 380 

410 T=0:FOR I=1TO500:NEXT:PRINTS OD," ";:PRINTS OD, CHRS (179) ; 

420 FOR I=1TO750:NEXT 

430 PRINTS OE," ";:FOR I=1TO20:NEXT:OE=OE+1: PRINTS OE.DBS; 

440 FOR I=1TO100:T=T+1:IF T=2 THEN 450 ELSE 430 

450 T=0:PRINT8 OE," ";:FOR I=1TO20:OE=OE-64:PRINTS OE,DBS; 

460 FOR I=1TO750:NEXT:PRINTS OD, CHRS (140) ; 

470 FOR I=1TO500:NEXT:PRINTS OD, DBS; : PRINTS OE," " ; : FOR I=1TO500 :NEXT 

480 PRINTS OD,CHR$(17 9); 

490 FOR I=1TO1000:NEXT:CLS:PRINT:PRINT 

500 PRINT TAB(3)"THE TIME - 523 A.D." 

510 PRINT TAB(3)"THE PLACE - CAMELOT" 

520 PRINT TAB(3)"THE SITUATION - SERIOUS" : PRINT 

530 PRINT TAB(6) "MODRED - KING ARTHUR'S DREADED NEPHEW - WOULD" 

540 PRINT TAB(15)"LIKE TO MAKE CAMELOT HIS SUMMER HOME":PRINT 

550 PRINT TAB(6)"KING ARTHUR - WHO USES THE PLACE ON WEEKENDS -" 

560 PRINT TAB(20)"WILL HAVE NONE OF THIS NONSENSE !": PRINT 

570 PRINT TAB(6)"AND SO - THE BATTLE IS JOINED ":PRINT 

580 PRINT TAB(30)"TO CONTINUE PRESS /" 

590 KS=INKEY?:IF K?="/"THEN 600 ELSE 590 

600 CLS: PRINT: PRINT TABI22) "WHO'S WHO AT CAMELOT" : PRINT 

610 PRINT TAB(3) "INTRODUCING -":PRINT 

620 PRINT TAB(6)"KING ARTHUR'S BOWMEN 0" 
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630 PRINT TAB(6) "KING ARTHUR'S KNIGHTS * *" :PRINT: PRINT 

640 PRINT TAB(6) "MODRED'S BOWMEN X X X X X X X" 

650 PRINT TAB(6) "MODRED'S KNIGHTS » #" :PRINT:PRINT: PRINT 

660 PRINT TAB(30)"TO CONTINUE PRESS /"; 

670 KS=INKEY$:IF K$="/"THEN 680 ELSE 670 

680 CLS:PRINT TAB(19)"HOW THE ISSUE WILL BE DECIDED" : PRINT 

690 PRINT'TO CAPTURE CAMELOT -" 

700 PRINT TAB(3)"MODRED MUST SUCCEED AT ONE OF THE FOLLOWING" 

710 PRINT TAB(3) "STRATEGIES - BEFORE HIS PROVISIONS RUN OUT:":PRINT 

720 PRINT TAB(6)". GET A MAN INTO THE CASTLE WITHOUT LOSING MORE THAN" 

730 PRINT TAB(8)"ONE OF HIS TWO KNIGHTS - OR MORE THAN 4 MEN IN TOTAL":PRINT 

740 PRINT TAB(6)". ELIMINATE ANY 7 OF KING ARTHUR'S MEN":PRINT 

750 PRINT TAB(6>". STARVE CAMELOT OUT":PRINT 

760 PRINT "OTHERWISE - THE SIEGE OF CAMELOT FAILS AND MODRED MUST" 

770 PRINT TAB(12)"SPEND THE SUMMER IN HOT AND HUMID LONDON!" 

780 PRINT TAB(30)"TO CONTINUE PRESS /",- 

790 KS=INKEYS:IF K$="/" THEN 800 ELSE 790 

800 CLS: PRINT: PRINT TAB(25)"WHO CAN DO WHAT":PRINT 

810 PRINT "BOWMEN -":PRINT TAB(3)"CAN ADVANCE, WITHDRAW OR MOVE HORIZONTALLY -" 

820 PRINT TAB(3) "EITHER 1 OR 2 RODS" 

830 PRINT"KNIGHTS -":PRINT TAB(3)"CAN ADVANCE OR WITHDRAW DIAGONALLY -" 

840 PRINT TAB(3)"FROM 1 TO 6 RODS": PRINT 

850 PRINT'A MAN IS ELIMINATED WHEN HIS POSITION IS OCCUPIED BY" 

860 PRINT"ANOTHER MAN - WHETHER FRIEND OR FOE, BOWMAN OR KNIGHT" 

870 PRINT:PRINT TAB(30)"TO CONTINUE PRESS /" 

880 K$=INKEY$:IF KS="/"THEN 890 ELSE 880 

890 CLS:PRINT:PRINT TAB( 20) "ABOUT ENTERING THE CASTLE" : PRINT 

900 PRINT"THE CASTLE CAN BE ENTERED BY ANY" 

910 PRINT"OF MODRED'S MEN - BUT ONLY IF -":PRINT 

920 PRINT TAB (3) "MODRED'S MAN IS POSITIONED 'DEAD CENTER' IN" 

930 PRINT TAB(3) "FRONT OF THE CASTLE (WHERE DRAWBRIDGE OPENS) ": PRINT 

940 PRINT TABU) "AND THAT POSITION DEFENDED UNTIL MODRED'S NEXT TURN":PRINT 

950 PRINT TAB(3)"THEN •• ANY FORWARD MOVE WILL GAIN ACCESS TO THE CASTLE" :PRINT: P 

RINT 

960 PRINT TAB(30)"TO CONTINUE PRESS /" 

970 K$=INKEY$:IF K$="/"THEN 980 ELSE 970 

980 CLS:PRINT:PRINT TAB(24)"HOW TO MOVE MEN":PRINT 

990 PRINT"PRESS SPACE BAR UNTIL MAN TO BE MOVED IS BLINKING" :PRINT 

1000 PRINT"THEN SELECT DIRECTION IN WHICH MAN IS TO MOVE":PRINT 

1010 PRINT"THEN SELECT DISTANCE MAN IS TO MOVE": PRINT 

1020 PRINT"FOLLOWING OUTCOME OF MOVE - PLAY AUTOMATICALLY GOES TO OPPONENT" : PRIN 

T: PRINT 
1030 PRINT "BEFORE CONTINUING -" 
1040 PRINT TAB(3) "DECIDE WHO WILL ACT FOR KING ARTHUR AND WHO FOR MODRED" : PRINT 

1050 PRINT TAB(16)"TO BEGIN THE SIEGE OF CAMELOT PRESS /"; 

1060 K$=INKEY$:IF K?="/"THEN 1070 ELSE 1060 

1070 NG=l:GOTO 90 

1080 D1=404:D2=40 8:D3=412:D4=416:D5=420:D6=424:D7=428:D8=34 8:D9=356 

1090 A1=852:A2=856:A3=860:A4=864:A5=868:A6=872:A7=876:A8=924:A9=932 

1100 DS=404:AS=85 2:PD=200:PA=20 0:LD=139:LA=181 

1110 FOR I=1T07:PRINTS DS,DB$; : DS=DS+4 :NEXT 

1120 PRINTS D8,DKS;: PRINTS D9,DK$; 

1130 FOR I=1T07:PRINT@ AS,AB$; :AS=AS+4:NEXT 

1140 PRINTS A8,AK$;:PRINTS A9,AKS; 

1150 PRINTS 64, "KING ARTHUR'S" ; :PRINTS 128 ."PROVISIONS: "; rPRINTS 146, "DAYS"; 

1160 PRINTS 106,"MODRED'S";:PRINTS 170 , "PROVISIONS: "; :PRINTS 188, "DAYS"; 

1170 PRINTS LD,PD;:PRINT6 LA,PA; 

1180 PRINTS 0,STRING$(63,128); 

1190 IF TR=2 THEN 1350 

1210 R=R+1 

1220 IF R>9 THEN R=l 

1230 IF R=l THEN P=A1 

1240 IF R=2 THEN P=A2 

1250 IF R=3 THEN P=A3 

1260 IF R=4 THEN P=A4 

127 IF R=5 THEN P=A5 

1280 IF R=6 THEN P=A6 

1290 IF R=7 THEN P=A7 

1300 IF R=8 THEN P=A8 

1310 IF R=9 THEN P=A9 

1320 IF P=0 THEN 1180 

1330 GOTO 1490 

1350 R=R+1 

1360 IF R>9 THEN R=l 

1370 IF R=l THEN Q=D1 

1380 IF R=2 THEN Q=D2 

1390 IF R=3 THEN Q=D3 

1400 IF R=4 THEN Q=D4 

1410 IF R=5 THEN Q=D5 

1420 IF R=6 THEN Q=D6 

1430 IF R=7 THEN Q=D7 

1440 IF R=8 THEN Q=D8 

1450 IF R=9 THEN Q=D9 

1460 IF Q=0 THEN 1180 

1470 GOTO 1580 

1480 REM ** PULSE/ACTIVITY SELECTION ROUTINE - ATTACKING FORCE ** 

1490 PRINTS 960, "PRESS SPACE BAR TO CHOOSE MAN PRESS M TO MOVE MAN 
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1500 K$=INKEY$ 

1510 PA=PA-.1:PA=PA+.05:PA=INT(PA*10)/10 

1520 PRINTS LA,PA;:IF PA=0 THEN 3700 

1530 PRINTS P," ",-:FOR I=1TO20:NEXT 

1540 IF R<8 THEN PRINTS P,AB?; ELSE PRINTS P,AK$;:FOR I=1TO20:NEXT 

1550 IF K$="M" THEN 1660 

1560 IF K$=" " THEN 1180 ELSE 1500 

1580 PRINTS 960, "PRESS SPACE BAR TO CHOOSE MAN PRESS H TO HOVE MAN 

1590 K$=INKEY$ 

1600 PD=PD-.1:PD=PD+.05:PD=INT(PD*10)/10 

1610 PRINTS LD,PD;:IF PD=0 THEN 3730 

1620 PRINTS Q," ";:FOR I=1TO20:NEXT 

1630 IF R<8 THEN PRINTS Q,DBS; ELSE PRINTS Q,DKS;:FOR I=1TO20:NEXT 

1640 IF K$="M" THEN 2470 

1650 IF KS=" " THEN 1350 ELSE 1580 

1660 REM ** BOWMAN MOVE ROUTINE - ATTACKING FORCE ** 

1670 PRINTS 960,STRINGS(63,CHR${128)) ;:IF R>7 THEN 2040 

1680 PRINTS 960, "LEFT (L) RIGHT (R) ADVANCE (A) WITHDRAW (W) 

1690 K$=INKEY$ 

1700 PA=PA-.1:PA=PA+.05:PA=INT(PA*10)/10 

1710 PRINTS LA,PA;:IF PA=0 THEN 3700 

1720 IF K$="L" THEN B=-l:GOTO 17 80 

1730 IF K$="R" THEN B=l:GOTO 1780 

1740 IF KS="A" THEN B=-64:GOTO 17 80 

1750 IF K$="W" THEN B=64:GOTO 17 80 

1760 IF KS="" THEN 1690 

1770 IF B=0 THEN 1680 

1780 PRINTS 960,STRINGS(63,CHR$(128)); 

1790 PRINTS 965, "HOW MANY RODS WOULDST THOU MOVE - BOWMAN? (1 OR 2)"; 

1800 KS=INKEY? 

1810 PA=PA-.1:PA=PA+.05:PA=INT(PA*10)/10 

1820 PRINTS LA,PA;:IF PA=0 THEN 3700 

1830 IF K$="l" THEN L=1:J=0:GOTO 1870 

1840 IF K$="2" THEN L=2!j=0:GOTO 1870 

1850 IF KS="" THEN 1800 

1860 IF L=0 THEN 17 90 

1870 PRINTS P," ";:P=P+B:J=J+1:IF P=288 Z=l 

1880 IF Z=l PRINTS 288,AB$;:Z=2:GOSUB 3170 :GOSUB 3770 iGOSUB 2430 :GOTO 1950 

1890 IF Z=2 THEN 1920 

1900 IF P<256 THEN PRINTS P~B, AB$; : P=P-B:GOSUB 3170 :GOSUB 3770 :GOTO 1950 

1910 IF P>959 THEN PRINTS P-B, AB$; : P=P-B:GOSUB 3170 :GOSUB 3770 :GOTO 1950 

1920 PRINTS P,ABS;:GOSUB 3170 :GOSUB 3770 

1930 IF P<256 THEN 3660 

1940 IF J=L THEN 1950 ELSE 1870 

1950 IF R=l THEN A1=P 

1960 IF R=2 THEN A2=P 

1970 IF R=3 THEN A3=P 

1980 IF R=4 THEN A4=P 

1990 IF R=5 THEN A5=P 

2000 IF R=6 THEN A6=P 

2010 IF R=7 THEN A7=P 

2020 S=0:J=0:B=0:L=0:TR=2:GOTO1180 

2030 REM ** KNIGHT MOVE ROUTINE - ATTACKING FORCE ** 

2040 PRINTS 960,STRING$(63,128);:C=0 

2050 PRINTS 960, "TO CHARGE: LEFT (L) RIGHT (R) TO WITHDRAW: LEFT (Z) RIGHT (/) 

2060 K5=INKEY5 

2070 PA=PA-.1:PA=PA+.05:PA=INT(PA*10)/10 

2080 PRINTS LA,PA;:IF PA=0 THEN 3700 

2090 IF K$="L"THEN C=-66 :W=0:GOTO 2150 

2100 IF K$="R"THEN C=-62 :W=0 :GOTO 2150 

2110 IF K$="Z"THEN C=62 :W=l:GOTO 2150 

2120 IF K$="/"THEN C=66 :W=1 :GOTO 2150 

2130 IF K5=""THEN 2060 

2140 IF C=0 THEN 2050 

2150 PRINTS 960,STRINGS(63,128) ; 

2160 IF W=l THEN 2180 

2170 PRINTS 969, "HOW MANY RODS WOULDST THOU CHARGE - SIRE? (1 TO 6)";:GOTO 2190 

2180 PRINTS 968, "HOW MANY RODS WOULDST THOU WITHDRAW - SIRE? (1 TO 6)"; 

2190 K5=INKEYS 

2200 PA=PA-.1:PA=PA+.05:PA=INT(PA*10)/10 

2210 PRINTS LA, PA;: IF PA=0 THEN 3700 

2220 IF K$="l" THEN M=l:GOTO 2330 

2230 IF K?="2" THEN M=2:GOTO 2330 

2240 IF K5="3" THEN M=3:GOTO 2330 

2250 IF K$="4" THEN M=4:GOTO 2330 

2260 IF K?="5« THEN M=5:GOTO 2330 

2270 IF K$="6" THEN M=6:GOTO 2330 

2280 IF K$=""THEN 2190 

2290 IF M=0 THEN 2160 

2300 PRINTS 960,STRING$(63,128); 

2310 IF R=8 THEN A8=P:TR=2:GOSUB 3770 :GOTO 1180 

2320 IF R=9 THEN A9=P:TR=2:GOSUB 3770 :GOTO 1180 

2330 PRINTS P," ";:P=P+C:IF P=288 THEN Z=l 

2340 IF P>959 THEN PRINTS P-C,AK$:P=P-C:GOTO 2300 

118 



2350 IF Z«l THEN PRINTS P,AK$; : Z=2:G0SUB 3170 :GOSUB 3770 :GOSUB 2430 :G0TO 2420 

236B IP Z=2 THEN 2390 

237B IP P<256 THEN PRINT6 P-CAKS; :P=P-C:GOTO 2300 

2380 GOSUB 317B :GOSUB 377B 

2390 Z-=0:PRINTS P,AK$i : J=J+1: IP P<256 THEN 366B 

2400 IFJ>=M THEN 242B 

241B GOTO 2330 

2420 S=0:M=0:J=0:GOTO 2300 

2430 PRINTS 11,"M D R E D HAN AT DRAWBRIDGE lil"; 

244B FOR I=1TO750:NEXT:PRINTS 11,STRING$(49,CHR$U28) ) ; : FOR I=1TO100:NEXT 

2450 S=S+1: IP S=3 THEN RETURN ELSE 2430 

2460 REM ** BOWMAN MOVE ROUTINE - DEFENDING FORCE ** 

2470 PRINTS 960,STRINGS(63,CHR$(128));:IF R>7 THEN 2810 

2480 PRINTS 960, "LEFT (L) RIGHT (R) ADVANCE (A) WITHDRAW (W) 

"; 

249B KS=INKEY$ 

250B PD=PD-.1:PD=PD+.05:PD=INT(PD*1B)/10 

2510 PRINTS LD,PD;:IP PD=0 THEN 3730 

2520 IF K$="L" THEN B=-l:GOTO 2580 

2530 IF KS="R" THEN B=l:GOTO 2580 

2540 IP K$="A" THEN B=64:GOTO 2580 

2550 IF K$="W" THEN B=~64:GOTO 2580 

256B IP K$="" THEN 2490 

2570 IP B=0 THEN 2480 

2580 PRINTS 960,STRING$(63,CHR$(128)); 

259B PRINTS 965, "HOW MANY RODS WOULDST THOU MOVE - BOWMAN? (1 OR 2)"; 

260B K$=INKEY$ 

2610 PD=PD-.1:PD=PD+.05:FD=INT(PD*10)/10 

2620 PRINTS LD,PD;:IF PD=0 THEN 3730 

2630 IF K$="l" THEN L=1:J=0:GOTO 2670 

2640 IF K$="2" THEN L=2:J=0:GOTO 2670 

2650 IF K$="" THEN 2600 

2660 IF L=0 THEN 2590 

2670 PRINTS Q," "; :Q=Q+B: J=J+1 

2680 IF Q<256 THEN PRINTS Q-B,DB$; :Q=Q-B:GOSUB 3370 :GOSUB 4010 :GOTO 2720 

2690 IF Q>959 THEN PRINTS Q-B,DB$; :Q=Q-B:GOSUB 3370 :GOSUB 4010 :GOTO 2720 

2700 PRINTS Q,DBSj:GOSUB 3370 :GOSUB 4010 

2710 IF J=L THEN 2720 ELSE 2670 

2720 IF R=l THEN D1=Q 

27 30 IF R=2 THEN D2=Q 

27 40 IF R=3 THEN D3=Q 

2750 IF R=4 THEN D4=Q 

2760 IF R=5 THEN D5=Q 

2770 IF R=6 THEN D6=Q 

2780 IF R=7 THEN D7=Q 

2790 J=0:L=0:B=0:TR=1:GOTO 1180 

2800 REM ** KNIGHT MOVE ROUTINE - DEFENDING FORCE ** 

2810 PRINTS 960,STRING$(63,128);:C=0 

2820 PRINTS 960, "TO CHARGE: LEFT (L) RIGHT (R) TO WITHDRAW: LEFT (Z) RIGHT (/) 

2830 K$=INKEY$ 

2840 PD=PD-.1:PD=PD+.05:PD=INT(PD*10)/10 
2850 PRINTS LD,PD;:IF PD=0 THEN 3730 
2860 IF K$="L"THEN C=62 :W=0:GOTO 2920 
2870 IF KS="R"THEN C=66 :W=0:GOTO 2920 
2880 IF K?="Z"THEN C=-66 :W=l:GOTO 2920 
2890 IP K$="/"THEN C=-62:W=l:GOTO 2920 
2900 IF K$=""THEN 2830 
2910 IP C=B THEN 2820 
2920 PRINTS 960,STRING$(63,128); 
2930 IP W=l THEN 2950 

2940 PRINTS 969, "HOW MANY RODS WOULDST THOU CHARGE - SIRE7 (1 TO 6)";:GOTO 2960 
2950 PRINTS 968, "HOW MANY RODS WOULDST THOU WITHDRAW - SIRE? (1 TO 6)"; 
2960 KS=INKEY$ 

2970 PD=PD-.1:PD=PD+.05:PD=INT(PD*10)/10 
2980 PRINTS LD,PD;:IF PD=0 THEN 3730 
2990 IF KS="1"THEN M=l:GOTO 3100 
3000 IF K$="2"THEN M=2:GOTO 3100 
3010 IF K$="3"THEN M=3:GOTO 3100 
3020 IF KS="4"THEN M=4:GOTO 3100 
3030 IF K$="5"THEN M=5:GOTO 3100 
3040 IF K$="6"THEN M=6:GOTO 3100 
3050 IF K?=""THEN 2960 
3060 IF M=0 THEN 2930 
3070 PRINTS 960,STRING$(63,128); 

3080 IF R=8 THEN D8=Q:TR=l:GOSUB 4010 :GOTO 1180 
3090 IF R=9 THEN D9=Q:TR=1 :GOSUB 4010 :GOTO 1180 
3100 PRINTS Q," ";:Q=Q+C 

3110 IP Q>959 THEN PRINTS Q-C,DKS; : 0=Q-C :GOTO 3070 
3120 IF Q<256 THEN PRINTS Q-CDKS; :Q=Q-C:GOTO 3070 
3130 GOSUB 3370 :GOSUB 4010 
3140 PRINTS Q,DK$;:J=J+1:IF J>=M THEN 3160 
3150 GOTO 3100 
3160 M=0:J=0:GOTO 3070 

3170 REM ** ENEMY CONTACT ROUTINE - ATTACKING FORCE ** 

3180 IF P=D1 OR P=D2 OR P=D3 OR P=D4 OR P=D5 OR P=D6 OR P=D7 OR P=D8 OR P=D9 THE 
N 3190 ELSE 3360 
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3190 K=0 

3200 IF R=8 OR R=9 THEN AS$=AK$ ELSE ASS=ABS 

3210 PRINTS P," ";:FOR I=1T015 :NEXT:PRINTS P,AS$;:FOR I=1T015:NEXT 

3220 K=K+1:IF K=7 THEN 3240 

3230 GOTO 3210 

3240 IF D1=P THEN 01=0 

3250 IF D2=P THEN D2=0 

3260 IF D3=P THEN D3=0 

3270 IF D4=P THEN D4=0 

3280 IF D5=P THEN D5 = 

3290 IF D6=P THEN D6=0 

3300 IF D7=P THEN D7=0 

3310 IF D8=P THEN D8 = 

3320 IF D9=P THEN D9=0 

3330 PRINTS 0,STRING$(63,CHR$<128)); 

3340 DL=DL+1: PRINTS 18,"HAHI1I - THAT'S";DL; " FOR MODREDIil"; 

3350 FOR I=1TO1000:NEXT:IF DL=7 THEN 3660 

3360 RETURN 

3370 REM ** ENEMY CONTACT ROUTINE - DEFENDING FORCE *» 

3380 IF Q=A1 OR Q=A2 OR Q=A3 OR Q=A4 OR Q=A5 OR Q=A6 OR Q=A7 OR Q=A8 OR Q=A9 THE 

N 3390 ELSE 3580 
3390 K=0 

3400 IF R=8 OR R=9 THEN DSS=DK$ ELSE DS$=DBS 

3410 PRINTS Q," ";:FOR I=1T015 :NEXT:PRINTS Q,DS$;:FOR I=1T015:NEXT 
3420 K=K+1:IF K=7 THEN 3440 
3430 GOTO 3410 
3440 IF A1=Q THEN A1=0 
3450 IF A2=Q THEN A2=0 
3460 IF A3=Q THEN A3=0 
3470 IF A4=Q THEN A4=0 
34 80 IF A5=Q THEN A5=0 
3490 IF A6=Q THEN A6=0 
3500 IF A7=Q THEN A7=0 
3510 IF A8=Q THEN A8=0:L1=1 
3520 IF A9=Q THEN A9=0:L2=1 
3530 IF Ll-1 AND L2=l THEN 3590 
3540 PRINTS 0,STRING$(63,CHR$<128)) ; 

3550 AL=AL+1:PRINTS 15,"HAH!II - THAT' S" ; AL; " FOR KING ARTHUR I 1 I " ; 
3560 FOR I=1TO1000:NEXT 
3570 IF AL=5 THEN 3620 
3580 RETURN 

3590 PRINTS 0,STRING$(63,CHR$(128)); 

3600 PRINTS 15, "BOTH MODRED'S KNIGHTS ARE DONE IN I I !"; 
3610 FOR I=1TO2000:NEXT:PRINTS 15 ,STRINGS(40,CHR$ (128) ) ; 
3620 PRINTS 15," CAMELOT IS SAVED! I!"; 

3630 FOR I=1TO750:NEXT:PRINTS 17 , STRING? (38, CHRS (128) ); :FOR I=1TO100:NEXT 
3640 T=T+1:IF T=3 THEN 3650 ELSE 3620 

3650 L1=0:L2=0:Z=0:Y=0:T=0:S=0:J=0:NG=1:TR=0:GOTO 4240 
3660 PRINTS ll,"m D R E D IS VICTORIOUS! 11"; 
3670 FOR I=1TO750:NEXT:PRINT8 11,STRINGS(44 ,CHR$ (128) ) ; :FOR I=1TO100:NEXT 
3680 T=T+1:IF T=3 THEN 3690 ELSE 3660 
3690 Z=0:J=0:M=0:T=0:S=0:NG=1:TR=2:GOTO 4240 

3700 PRINTS 11, "MODRED'S ARMS DEPLETED!!!"; 
3710 FOR I=1TO750:NEXT:PRINTS 11, STRINGS (47 ,CHR$ (128) );: FOR I=1TO100 :NEXT 
3720 S=S+1:IF S=3 THEN 3620 ELSE 3700 

3730 PRINTS 12, "C AMELOT STARVED OUT! II"; 
3740 FOR I=1TO750:NEXT:PRINTS 12,STRING$(41 ,CHR$ (128) ) ; : FOR I=1TO100 :NEXT 
3750 S=S+1:IF S=3 THEN 3660 ELSE 3730 

3760 REM ** OWN MAN CONTACT ROUTINE - ATTACKING FORCE ** 
3770 ON R GOTO 3780 ,3790 ,3800 ,3810 ,3820 ,3830 ,3840 ,3850 ,3860 
3780 IF P=A2 OR P=A3 OR P=A4 OR P=A5 OR P=A6 OR P=A7 OR P=A8 OR P=A9 THEN 3870 E 

LSE 3990 
3790 IF P=A1 OR P=A3 OR P=A4 OR P=A5 OR P=A6 OR P=A7 OR P=A8 OR P=A9 THEN 3870 E 

LSE 3990 
3800 IF P=A1 OR P=A2 OR P=A4 OR P=A5 OR P=A6 OR P=A7 OR P=A8 OR P=A9 THEN 3870 E 

LSE 3990 
3810 IF P=A1 OR P=A2 OR P=A3 OR P=A5 OR P=A6 OR P=A7 OR P=A8 OR P=A9 THEN 3870 E 

LSE 3990 
3820 IF P=A1 OR P=A2 OR P=A3 OR P=A4 OR P=A6 OR P=A7 OR P=A8 OR P=A9 THEN 3870 E 

LSE 3990 
3830 IF P=A1 OR P=A2 OR P=A3 OR P=A4 OR P=A5 OR P=A7 OR P=A8 OR P=A9 THEN 3870 E 

LSE 3990 
3840 IF P=A1 OR P=A2 OR P=A3 OR P=A4 OR P=A5 OR P=A6 OR P=A8 OR P=A9 THEN 3870 E 

LSE 3990 
3850 IF P=A1 OR P=A2 OR P=A3 OR P=A4 OR P=A5 OR P=A6 OR P=A7 OR P=A9 THEN 3870 E 

LSE 3990 
3860 IF P=A1 OR P=A2 OR P=A3 OR P=A4 OR P=A5 OR P=A6 OR P=A7 OR P=A8 THEN 3870 E 

LSE 3990 
3870 IF P=A1 THEN A1=0 
3880 IF P=A2 THEN A2=0 
3890 IF P=A3 THEN A3=0 
3900 IF P=A4 THEN A4=0 
3910 IF P=A5 THEN A5=0 
3920 IF P=A6 THEN A6=0 
3930 IF P=A7 THEN A7=0 
3940 IF P=A8 THEN A8=0:L1=1 
3950 IF P=A9 THEN A9=0:L2=1 
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3960 IF R<8 THEN PRINTS P.ABS; ELSE PRINTS P.AKS; 

3970 PRINTS 13, "OAF III - THOU DIDST IN ONE OF THINE OWN MEN 111"; 

3980 FORI=1TO1000:NEXT:AL=AL+1:IF 1,1=1 AND 1,2=1 THEN 3590 

3990 RETURN 

4000 REM ** OWN MAN CONTACT ROUTINE - DEFENDING FORCE ** 

4010 ON R GOTO 4020 ,4030 ,4040 ,4050 ,4060 ,4070 ,4080 ,4090 ,4100 

4020 IF Q=D2 OR Q=D3 OR Q=D4 OR Q=D5 OR Q=D6 OR Q=D7 OR Q=D8 OR Q=D9 THEN 4110 E 

LSE 4230 
4030 IF Q=D1 OR Q=D3 OR Q=D4 OR Q=D5 OR Q=D6 OR Q=D7 OR Q=D8 OR Q=D9 THEN 4110 E 

LSE 4230 
4040 IF Q=D1 OR Q=D2 OR Q=D4 OR Q=D5 OR Q=D6 OR Q=D7 OR Q=D8 OR Q=D9 THEN 4110 E 

LSE 4230 
4050 IF Q=D1 OR Q=D2 OR Q=D3 OR Q=D5 OR Q=D6 OR Q=D7 OR Q=D8 OR Q=D9 THEN 4110 E 

LSE 4230 
4060 IF Q=D1 OR Q=D2 OR Q=D3 OR Q=D4 OR 0=D6 OR Q=D7 OR Q=D8 OR Q=D9 THEN 4110 E 

LSE 4230 
4070 IF Q=D1 OR Q=D2 OR Q=D3 OR Q=D4 OR Q=D5 OR Q=D7 OR Q=D8 OR Q=D9 THEN 4110 E 

LSE 4230 
4080 IF Q=D1 OR Q=D2 OR Q=D3 OR Q=D4 OR Q=D5 OR Q=D6 OR Q=D8 OR Q=D9 THEN 4110 E 

LSE 4230 
4090 IF Q=D1 OR Q=D2 OR Q=D3 OR Q=D4 OR Q=D5 OR Q=D6 OR Q=D7 OR 0=D9 THEN 4110 E 

LSE 4230 
4100 IF Q=D1 OR Q=D2 OR Q=D3 OR Q=D4 OR Q=D5 OR Q=D6 OR Q=D7 OR Q=D8 THEN 4110 E 

LSE 4230 
4110 IF Q=D1 THEN D1=0 
4120 IF Q=D2 THEN D2=0 
4130 IF Q=D3 THEN D3=0 
4140 IF Q=D4 THEN D4 = B 
4150 IF Q=D5 THEN D5=0 
4160 IF Q=D6 THEN D6=0 
4170 IF Q=D7 THEN D7=0 
4180 IF Q=D8 THEN D8=0 
4190 IF Q=D9 THEN D9=0 

4200 IF R<8 THEN PRINTS Q,DB$; ELSE PRINTS Q,DK$; 

4210 PRINTS 13, "OAF 111 - THOU DIDST IN ONE OF THINE OWN MEN ill"; 
4220 FOR I=1TO1000:NEXT:DL=DL+1 
4230 RETURN 

4240 PRINTS 960,STRING?(63,CHR$(128)) ; 
4250 PRINTS 960, "TO REVIEW INSTRUCTIONS - PRESS I FOR ANOTHER GAME - PRESS G 

4260 K?=INKEYS 

4270 IF KS="I" THEN 600 

4280 IF KS="G" THEN 90 ELSE 4260 



DEDUCTION: by Al Leavitt 



If you like to play the game of 
Clue, you'll enjoy this program. 
You must deduce the symbol the 
computer has selected in each of 
four locations in ten or less 
moves. If you do, you win. It's 
that simple. 
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10 DIMDI3) ,R(3),S(6),T(3):RANDOM 

15 DEFSTRR-U:DBFINTA-P 

20 S(0)="[":S(1)="#":S(2)="%":S(3)=' 



5":S(4)="*":S{5)="S" 
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30 S (6 ) ="S" : CLS : PRINT825 , "DEDUCTION" : PRINT: PRINT 

50 PRINT-DO YOU WANT TO PLAY DEDUCTION WITH ME? IF YOU DO, TELL HE THE SKTfr r 
EVEL TO USE AND I WILL RANDOMLY SELECT ONE SYMBOL FOR EACH OF FOUR MCAT 

M ^THrFOufLScATKNs!"" ™ ^ ^^ * ^ ° F ^ SYMB ° M ' ™ E F0R EACH 0P 
70 PR ™T"IF A PAIR OF OUR SELECTIONS HAVE THE SAME SYMBOL AND LOCATION YOU SCO 

"LmVlScSon^o- Se°I sSolT ? CTI0NS HAVE THE SA ™ S ™" 0L " t 5SS the! 
80 ^ouIIelSS^o^nTf ?£ ±ir T Tl%lo^%^^ for^acY 

OF THE FOUR LOCATIONS IN TEN OR FEWER MOVES " SELECTED FOR EACH 

90 PRINT8960,"";:INPUT"DEPRESS ENTER TO CONTINUE";U 
100 CLS:PRINT8151, "SKILL LEVELS" :PRINT 

110 ^lll^l ™ B ° L J' < '• *I *' »• *' AND 8 ), AND I WILL NOT SELECT DUPL 



1M P ^ N r,L-?^L S ™°^ S ' I'' !• *I S ' *- S- AND ? ,, AND I WILL .NOT SELE 



ICATES FOR A TOTAL OF 360 POSSIBILITIES" 
PRINT"2-SEVEN SYMBOLS, { (, S, %, s , *, g „,„ ., 
CT DUPLICATES FOR A TOTAL OF 840 POSSIBILITIES" 
" Tof "?;9 AH P0SSIB?LI??E! " S SHLL LEVEL X ' m l HM DUP "=ATE FOR A TOTA 

" P ?AL T ; F 1Z P^MlSs^ SKItL LEVEL 2 ' BUT * ™ DUP " CME P °* A TO 

150 PRINT8832,"TYPE SKILL LEVEL, 1, 2, 3, OR 4". 

160 U=INKEY?:N=VAL(U) : IFN<1ORN>4GOTO160 

170 CLS:PRINT"SYMBOLS";TAB(23) "LOCATIONS" ;TAB(49) "SCORES" 

180 PRINT"LEVEL";N;:F0RI=1T04:PRINT879+(I-1)*7,I;:NEXT 

190 PRINT8108, "DOUBLES SINGLES" :FORI=0TO5 : PRINT8131+I*64 ,S < I) • 

200 NEXT:IFN=20RN=4PRINT8515,S(6) *«ueiJ±-n b«,SU), 

210 PRINT8576, "MOVE" :PRINT"NO" :FORI=0TO3 :ONNGOTO220 , 240, 260, 270 

230 ^™^ ) "" 1:POM=0TOI:IF ' r ( J l<> s ( L )NEXT:GOTO280 

240 L=RND(7)-1:FORJ=0TOI:IFT(J)<>S(L)NEXT:GOTO280 

250 GOTO240 

260 L=RND(6)-1:GOTO280 

270 L=RND(7)-1 

280 T(I)=S(L):NEXT:FORI=1TO10:PRINT8642,I:FORK=OTO3 

290 PRINT8768,"TYPE SYMBOL FOR LOCATION NUMBER ";K+1 

300 U=INKEY$:ONNGOTO310,330,310,330 

310 FORJ=0TO5:IFUOS(J)NEXT:GOTO300 

320 GOTO340 

330 FORJ=0TO6:IFUOS(J)NEXT:GOTO300 

340 PRINT880+I*64+K*7,U;:R(K)=U:NEXTK:GOTO440 

350 PRINT8768,"TYPE LOCATION THAT YOU WANT TO CHANGE"- 

360 U=INKEY5:L=VAL(U):IFL<1ORL>4GOTO360 

370 L=L-1:C=80+I*64+L*7:PRINT8C," "• 

380 PRINT8768,"TYPE NEW SYMBOL FOR LOCATION NUMBER ";L+1; 

390 U=INKEY$:ONNGOTO400,420,400,420 

400 FORJ=0TO5:IFUOS(J)NEXT:GOTO390 

410 GOTO430 

420 FORJ=0TO6 : IFUOS (J) NEXT:GOTO390 

430 PRINT8C,U;:R{L)=U 

440 PRINT8768, "SHALL I DO MY THING-TYPE YES OR NO 

450 U=INKEY$:IFU<>"N"ANDUO"Y"GOTO450 

460 IFU="N"GOTO350 

470 E=0 : FORJ=0TO3 :D ( J) =0 : NEXT: FORJ=0TO3 ■ FORK-flfnn 

480 IPR(K)=T(J)ANDD(J)=0THEND(5)=f - FORK - 0T03 

490 NEXTK,J:FORJ=0TO3:E=E+D(J) :NEXT:D=0:FORJ=0TO3-D( J) =0-NEXT 

500 FORJ=0TO3:IFR(J)=T(J)THEND(J)=1 " 0-NEXT 

«2 ■J E ^ T: f°R J =B'r03:D=D+D(J) :NEXT:E=E-D: IFD=4GOTO530 

520 PRINT8110+I*64,D,-" ";E;:NEXT 

530 FORI=768TO1000:PRINT8I," ";:NEXT 

540 IFD=4PRINT8856, "YOU'VE WON":GOTO580 

550 PRINT6849, "TOUGH LUCK, YOU'VE LOST": 

560 PRINT8913, "WINNING SELECTIONS WERE"; 

570 FORI=0TO3:PRINT8977+7*I,T(I);:NEXT 

580 PRINT" ANOTHER GAME (Y/N)?" 

590 ZS=INKBY$:IFZ$=""THEN590 

600 IFZ$="Y"THEN15 

610 END 
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ANTENNA DESIGN AND VSWR : by Walter J. Atkins 



This program will calculate ex- 
act resonant lengths at any fre- 
quence for four popular ham an- 
tennas. The program will also 
calculate any of the following, if 
three of four values are known: 
forward power, reflected power, 
VSWR, % reflected power for a 
given VSWR. In addition, max- 
imum V. and I. along the trans- 
mission line are calculated for any 
value of input power. A must pro- 
gram for the antenna farming 
ham. 
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200 GOSUB9500 

300 CLS:PRINTCHR5(23):PRINT"WOULD YOU LIKE A" :PRINT"DESCRIPTION OF THE PROGRAM": 

PRINT" ( Y OR N ) ?" 
400 IS=INKEY$:IFI$=""THEN 400 
500 IFIS="Y" THEN 800 
600 IFISO"N" THEN 300 
700 GOTO900 
800 GOSHB1B500 
900 CLS:PRINTCHRS(23) :PRINT"WHICH DO YOU WISH ?" :PRINT:PRINT"1) ANTENNA DESIGN C 

ALCULATIONS" 
1000 PRINT:PRINT=2) VSWR CALCULATIONS" :PRINT:PRINT"INPUT CHOICE ==>"; 
1100 I$=INKEY$:IFI$=""THEN1100 
1200 U=VAL(I$) 

1300 IFU>2ORU<1THEN900: ELSECLS:ONUGOTO5900,1400 

1400 CLS: PRINT"* * * VOLTAGE STANDING WAVE RATIO CALCULATIONS * * *" 
1500 PRINT:PRINTTAB(5); "FOLLOWING OPTIONS ARE AVAILABLE:" 
1600 PRINT"1) INPUT FORWARD POWER & REFLECTED POWER, CALCULATE VSWR." 
1700 PRINT:PRINT"2) INPUT FORWARD POWER & VSWR, CALCULATE REFLECTED POWER." 
1800 PRINT:PRINT"3) INPUT VSWR, CALCULATE % REFLECTED POWER." 

1900 PRINT: PRINT"4) INPUT FORWARD POWER, VSWR, TRANSMISSION LINE IMPEDANCE," 
2000 PRINT"CALCULATE MAX. VOLTAGE S CURRENT ON TRANSMISSION LINE.": PRINT 
2100 PRINT"5)RESTART PROGRAM": PRINT 
2200 PRINT"INPUT CHOICE ==>" 
2300 IS=INKEYS:IFI$=""THEN2300 
2400 D=VAL(IS) 

2500 IFD<1ORD>5THEN1400:ELSEONDGOTO2600,3300,3800,4100,900 
2600 CLS:INPUT"ENTER ==>FORWARD POWER";A: IFA<=0THEN2600 :ELSEINPUT"ENTER ==>R 

EFLECTED POWER";B: IFB<0THEN2600:ELSECLS 
2650 IF B>A PRINT'ERROR REFLECTED POWER CANNOT EXCEED FORWARD POWER. ":FO 

RX=1TO1000:NEXTX:GOTO2600 
2700 X=B/A:IFABS(1-X)<1E-4S=999999:GOTO3000 
2800 Y=SQR(X) :S=(1+Y)/(1-Y) 
2900 IFS<326S=INT(S*100+. 5)/100 
3000 PRINTS80 , "FORWARD POWER -";A;" WATTS"; 
3100 PRINT8143, "REFLECTED POWER - ";B;" WATTS"; 
3200 PRINT6208,"VSWR =" ;S; "/l" :GOSUB9300 :K=0 :GOTO5100 
3300 CLS: INPUT" ENTER ==>FORWARD POWER" ;A: IFA<0THEN3300 
3400 INPUT"ENTER ==>VSWR";S: IF S<1 PRINT"VSWR CANNOT BE LESS THAN 1, PLEASE ENT 

ER AGAIN " :GOTO3400: ELSE Y= (S-l) / (S+l) 
3500 B=A*Y*Y:CLS:B=INT(B*10+.5)/10 

3600 PRINTS80, "FORWARD POWER -°;A;" WATTS" ; : PRINT6143, "VSWR - ";S;"/1" 
3700 PRINTS208 , "REFLECTED POWER =";B;" WATTS" :GOSUB9300: K=0 :GOTO5100 
3800 CLS:INPUT"ENTER ==>VSWR";S: IFS<1THENPRINT"VSWR MUST BEGREATER THAN 1" 

FORN1=1TO1000:NEXT:GOTO3800: ELSE Y= (S-l) / (S+l) :C=INT (Y*Y*1000 

0+. 51/100 
3900 CLS :PRINT@80, "VSWR -" ;S; "/l" :PRINT§208 , "REFLECTED POWER =";C;"%" 
4000 PRINTS208, "REFLECTED POWER =" ;C; "%" :GOSUB9300 : K=0 :GOTO5100 
4100 CLS:INPUT"ENTER ==>FORWARD POWER";A: IFA<=0THENPRINT"FORWARD POWER MUST 

BE POSITIVE": FORN1=1TO1000 :NEXT:GOTO4100 

4200 INPUT"ENTER ==>VSWR";S: IFS<1THENPRINT"VSWR MUST BE GREATER THAN 1": 

GOTO4200 
4300 INPUT"ENTER — >TRANS. LINE IMPEDANCE" ;G: IFG<=0THENPRINT" IMPEDANCE MUST 

BE POSITIVE" :GOTO4300 
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4400 E=SQR<A*S*G) :E=INT(E*100+. 51/100 

4500 I=INT(E/G*100+.5)/100:CLS 

4600 PRINT870, "FORWARD POWER - ";A;" WATTS" :PRINT8135, "VSWR - ";S;"/1" 

4700 PRINT8199,"LINE IMPEDANCE - ";G;" OHMS" 

4800 PRINT8263,"MAX. LINE VOLTAGE = ";B;" VOLTS" 

4900 PRINTS326,"MAX. LINE CURRENT = ";I;" AMPERES" 

5000 FORX=10TO90:SET(X,2):SET(X,19) :NEXTX:FORY=3TO18:SET{10,Y) :SET(90 ,Y) :NEXTY:K 

=0 
5100 PRINT§896, "CONTINUE IN THIS MODE (Y OR N) " 
5200 T5=INKEY$:IFT$=""THEN5200 
5300 CLS 

5400 IFLEFT$(T$,1)<>"Y" AND LEFT? (TS,1) <>"N"THEN5100 
5500 IFLEFT$(T$,1)="N" AND K=0 THEN 1500 
5600 IFLEFTS(TS,1)="N" AND K=l THEN CLS:GOTO6000 
5700 IFLEFT$(T$,1)="Y"AND K=l THEN6800 

5800 IFLEFTS(T$,1)="Y" AND K=0 THEN ON D GOTO 2600,3300,3800,4100 
5900 CLS:PRINT"* * * ANTENNA LENGTH CALCULATIONS * * *" 
6000 PRINT'FOLLOWING OPTIONS ARE AVAILABLE :" 

6100 PRINT:PRINT"1)HALF WAVE DIPOLE" :PRINT:PRINT"2)QUARTER WAVE VERTICAL" 
6200 PRINT: PRINT"3) 3/4 WAVELENGTH VERTICAL" 

6300 PRINT:PRINT"4)5/8 WAVELENGTH VERTICAL" : PRINT: PRINT: PRINT"5) RESTART PROGRAM" 
6400 U=0: PRINT" INPUT CHOICE ==>" 
6500 I$=INKEY$:IFI$=""THEN6500 
6600 U=VAL(I$) 
6700 IFU>5 OR U<1 THEN 5900 
6800 CLS:IFU=5THEN900 
6900 IFU=1THENN=468 
7000 IFU=2THENN=234 
7100 IFU=3THENN=702 
7200 IFU=4THENN=585 

7300 F=0:PRINT:INPUT"ENTER DESIRED RESONANT FREQUENCY (F) IN MHZ. ==> ";F:CLS 
7400 IFF<.022PRINT"FREQUENCY TOO LOW" :K=1 ;GOTO5100 
7500 IFF>1E3PRINT"FREQUENCY TOO HIGH" :K=1:GOTO5100 
7600 L=N/F:F=N/(L*L)-:P=P*1000 

7700 I=L-INT(L) :G=INT(L) :I=I*12: I=INT(I*100+. 51/100 

7800 M=L*.3048:M=INT(M*10000+.5)/10000:PRINT@66, "RESONANT FREQUENCY -";F;" MHZ." 
7900 PRINT6193, "ANTENNA LENGTH =";Gj" FT. ";I;" IN. (";M;" METERS)" 
8000 L=L/2:I=L-INT(L) : 1=1*12: I=INT(I*100+. 51/100 :G=INT(L) :M=L*.3048 :M=INT(M*1000 

0+. 51/10000 
8100 IFUO1THEN8300 

8200 PRINOT257, "ANTENNA HALF LENGTH =";G;" FT. ";I;" IN. (";M;" METERS)" 
8300 IFU=lTHENA$="l/2 WAVE DIPOLE" 
8400 IFU=2THENAS="l/4 WAVE VERT." 
8500 IFU=3THENA$="3/4 WAVE VERT." 
8600 IFU=4THENAS="5/8 WAVE VERT." 
8700 PRINT6321, "RESONANT FREQUENCY WILL CHANGE " ; INT(P/12*100+. 51/100; " KHZ. PER 

IN." 
8800 PRINT8110,A$:PRINT6385, "CHANGE IN ANTENNA LENGTH." 

8900 PRINTS449, "SHORTENING THE ANTENNA WILL RAISE RESONANT FREQUENCY."; 
9000 PRINT8513, "LENGTHENING IT WILL LOWER RESONANT FREQUENCY."; 
9100 FORX=0TO127:SET(X,0):SET(X,29):NEXTX:FORY=1TO28:SET(0,Y) :SET(127,Y) :NEXTY 
9200 F0RX=1T0126:SET(X,7) :NEXTX:F0RY=1T06:SET(75,Y) :NEXTY:K=1:GOTO5100 
9300 FORX=22TO105:SET{X,21:SET(X,15):NEXTX:FORY=2TO15:SET(22,Y) :SET(105,Y) :NEXTY 
9400 RETURN 
9500 REM INSTRUCTIONS 
9600 H$=STRING$(32,"I") 
9700 CLS:PRINTCHR$(23) :PRINT80,H?; : PRINT: PRINT: PRINT: PRINTTAB( 9) ; "ANTENNA DESIGN 

": PRINT 
9800 PRINTTAB(14);"AND":PRINT 

9900 PRINTTAB(6) ; "VOLTAGE STANDING WAVE":PRINT 
10000 PRINTTAB(10); "CALCULATIONS" 
10100 FORX=64T0896 STEP64:PRINT8X, "I"; :NEXTX 
10200 FORX=126T0959STEP64:PRINT6X,"I";:NEXTX 
10300 PRINT8896,H$; 
10400 FOR X=l TO 2000:NEXT:RETURN 
10500 CLS:PRINTCHR$(23) 

10600 PRINTTAB(3)"* * * ANTENNA DESIGN * * *" :PRINT:PRINT 
10700 PRINT" ANTENNA DESIGN IS A PROGRAM" 
10800 PRINT'TO DESIGN ANTENNAS THAT ARE" 
10900 PRINT "RESONANT AT A GIVEN FREQUENCY." 
11000 PRINT: PRINT "THE ANTENNAS INCLUDED ARE :" 
11100 PRINT" 1) HALF WAVE DIPOLE" 
11200 PRINT" 2) QUARTER WAVE VERTICAL" 
11300 PRINT" 3) 3/4 WAVE VERTICAL" 
11400 PRINT" 4) 5/8 WAVE VERTICAL." 

11500 PRINT: PRINT'PRESS ENTER TO CONTINUE" : INPUT 1$ 
11600 CLS:PRINTCHRS(23) 

11700 PRINT" THE PROGRAM FINDS THE LENGTH" 
11800 PRINT"OF THE ANTENNA AND PREDICTS HOW" 
11900 PRINT"MUCH THE RESONANT FREQUENCY" 
12000 PRINT"WILL CHANGE PER INCH CHANGE IN" 
12100 PRINT"ANTENNA LENGTH." 

12200 PRINT: INPUT'PRESS ENTER TO CONTINUE" ; IS :CLS: PRINTCHR$ ( 23) 
12300 PRINT" * * VOLTAGE STANDING WAVE * *" 
12400 PRINTTAB( 10); "CALCULATIONS": PRINT 
12500 PRINT" VOLTAGE STANDING WAVE RATIO" 
12600 PRINT'IS USED IN TUNING AN ANTENNA OR" 
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12700 PRINT" IN ANALYZING THE PERFORMANCE" 
12800 PRINT"OF AN ANTENNA ALONG WITH IT'S" 
12900 PRINT'TRANSMISSION LINE." 
13000 PRINT: INPUT"PRESS ENTER TO CONTINUE";I$ 
13100 CLS:PRINTCHR$(23) 

13200 PRINT" IT FINDS THE VSWR FROM THE" 
13300 PRINT'FORWARD POWER AND THE REFLECTED" 
13400 PRINT"POWER, IT FINDS THE REFLECTED" 
13500 PRINT"POWER FROM THE FORWARD POWER S" 
13600 PRINT'THE VSWR, AND IT CALCULATES THE" 
13700 PRINT"PERCENTAGE OF REFLECTED POWER" 
13800 PRINT"FOR A SPECIFIED VSWR.":PRINT 
13900 PRINT" THE PROGRAM ALSO FINDS THE" 
14000 PRINT"MAXIMUM VOLTAGE AND MAXIMUM" 
14100 PRINT"CURRENT ON THE TRANSMISSION" 
14200 PRINTLINE FEEDING THE ANTENNA. ": PRINT 
14300 INPUT"PRESS ENTER TO CONTINUE" ;I$ 
14400 RETURN 



OSCAR SATELLITE LOCATOR: by R.K. Bower 



Confused as to the elusive 
Oscar's whereabouts? After you 
supply the data base, this pro- 
gram will tell you where, when, 
orbit number, etc. for any future 
orbit. Takes the worry out of be- 
ing merely close. 




100 CLS:CLEAR 300:DEPINT I, J,K,N:RD=57 .29578:DIM MO(12) 

110 MO(1)=31:MO(3)=31:MO(4)=30:MO(5)=31:MO(6)=30:MO(7>=31 

111 MO(8)=31:MO(9)=30:MO(10)=31:MO(U)=30:MO(12)=31 

112 KDS(1)="J":MD?(2)="A":MD$(3)="AJ":MD$(4)="X" 

113 MD$(5)="A":MD$(6)="AJ":MD$(7)="J" 

114 DY$U)="SUN":DYS(2)="MON":DY$(3)="TUE":DY$(4)="WED" 

115 DY$(5)="THU":DY$(6)="FRI":DY$(7)="SAT" 

120 PRINT CHRS(23) 

121 PRINT6390, "OSCAR SATELLITE LOCATOR" : PRINT 

122 PRINT " WRITTEN BY R.K. BOWER, AC2C":PRINT 

123 PRINT " VERSION 2.0 1 JUNE 1979" 

124 FOR 1=1 TO 1500:NEXT I:CLS 

130 PRINT TAB(15) "INPUT DATA FOR LAST KNOWN ORBIT" :PRINT 
140 INPUT "ORBIT NUMBER" jNRS :NR=VAL(NR5) 

150 PRINT "DAY OF ORBIT, PRESS 'ENTER 1 IF UNKNOWN:" 

151 INPUT "(SUN, MON, TUE, WED, THU, FRI, SAT) ";A$ 

152 IF A$="" THEN 11=0: I2=4:G0TO 160 

153 FOR 1=1 TO 7:IF A$=DY$(I) THEN 155 

154 NEXT I: PRINT "INVALID INPUT" :GOTO 151 

155 11=1:12=11 

160 INPUT "ORBIT DATE (MM,DD,YY) " (M,D,Y 

161 GOSUB 1000: IF ER=1 THEN 160 

162 OY=Y:OD=Z 

170 INPUT "ORBIT EQUATOR CROSSING TIME (XXXX;XX) ";A$:OT=VAL(A5) 

171 T1=FIX(OT/100) :T2=OT-T1*100:OT=T1*60+T2 
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172 SS=RIGHT$(A$,3) :IF LEFTS (SS,1) =";" THEN 173 ELSE 180 

173 S=VAL(RIGHT$(S$,2)) : OT=OT+ ( S/6 ) 

180 INPUT "ORBIT EQUATOR CROSSING LONGITUDE (0 TO 360) ";OL 
190 INPUT "LONGITUDINAL PROGRESSION (DEGREES) "jDR 
200 INPUT "ORBITAL PERIOD (MINUTES) ";OP:PRINT 

210 INPUT "YOUR LONGITUDE (EITHER E/W OR 0-360) ";HLS 

211 IF RIGHTS (HL?,1)="E" THEN HL=360-VAL(HL$) ELSE HL=VAL(HLS) 

212 B=HL/RD 

220 INPUT "FIRST DATE OF INTEREST (MM,DD,YY) " ;M,D,Y 

221 GOSUB 1000: IF ER=1 THEN 220 

222 FY=Y:FD=Z 

230 INPUT "LAST DATE OF INTEREST (MM,DD, YY) " ;M,D,Y 

231 GOSUB 1000: IF ER=1 THEN 230 

232 LY=Y:LD=Z 

300 CLS:PRINT:PRINT"NO. DATE ORBIT NO. TIME" ;TAB(44) "LONG. "; rTAB ( 55) « 

ROTATION" ' 

301 FOR 1=1 TO 63:PRINT "=";:NEXT I:PRINT:N=1:LDS="" 
310 NR=NR+1:OL=OL+DR:OT=OT+OP 

320 IF OL=>360 THEN OL=OL-360 

330 IF OK1440 THEN 340 

331 OT=OT-1440:IP 11=0 THEN 12=4 ELSE I2=I2+1:IF I2>7 THEN 12=1 

332 OD=OD+l:IF OD<366 THEN 340 

333 IF OD=366 AND FIX(OY/4) *4=OY THEN 340 

334 OY=OY+l:OD=l:IF OY=100 THEN OY=0 

340 IF OY<FY THEN 310 

341 IF OY=FY AND OD<FD THEN 310 

342 IF OY=>LY AND OD>LD THEN DN=l:GOTO 650 

350 Tl=HL-OL:T2=OL-HL 

351 IF TK0 THEN Tl=Tl+360 ELSE IF T2<0 THEN T2=T2+360 

352 IF Tl<=33 OR T2<=26 THEN 500 

360 T3=OL+1B0+.5*DR:IF T3=>360 THEN T3=T3-360 

361 T1=HL-T3:T2=T3-HL 

362 IF 1KB THEN Tl=Tl+360 ELSE IF T2<0 THEN T2=T2+360 

363 IF Tl<=26 OR T2<=33 THEN 400 ELSE 310 

400 PL=OL+180+.5*DR:PT=OT+.5*OP:FD=OD:PY=OY:D$="N TO S" 

410 TM(N)=OP/2~16 

420 IF PL=>360 THEN PL=PL-360 

430 IF PK1440 THEN 600 

431 PT=PT-1440:PD=PD+1:IF PD<366 THEN 600 

432 IF PD=366 AND FIX(PY/4) *4=PY THEN 600 

433 PY=PY+1:PD=1:IF PY=100 THEN PY=0 

434 GOTO 600 

500 PL=OL:PT=OT:PD=OD:PY=OY:D$="S TO N" 
510 TM(N)=-6 

600 IF FIX(PY/4)*4=PY THEN HO(2)=29 ELSE HO(2)=28 

601 FOR 1=1 TO 12 

602 IF PD<=HO(I) THEN 604 

603 PD=PD-HO(I) :NEXT I 

604 PDS=RIGHTS(STR$(I+100),2)+"/"+RIGHTS(STR$(PD+100),2) 

605 PDS=PDS+"/"+RIGHT$(STRS(PY+100),2) 

606 IF PD$=LD$ PDS=" "+CHR$(34>+" "+CHR$(34) ELSE LD$=PD$ 

610 H=FIX(PT/60) :M=FIX(PT)-H*60:PT$=STRS(H*100+M+10000)+":" 

611 S=FIX((PT-FIX(PT) )*60+100. 5) :S$=RIGHT$ (STR$(S) , 2) +"Z" 

612 PTS=RIGHT$(PT$+SS,8) 

620 PRINT USING "H. ",-N;:PRINT PD$; 

621 PRINT TAB(16)NR;MD$(I2);TAB(29)PT$;TAB(44); 

622 PRINT USING "###. #";PL; : PRINT TAB(56)DS 

630 PDS(N)=LD$:OB$(N)=STR$(NR)+" "+MDS ( 12) : PTS (N) =PT$ : PL(N) =PL 

631 OT(N)=OT:OL(N)=OL 

640 N=N+1:IF N<10 THEN 310 

650 IF N=l THEN 670 ELSE PRINT8832 , ; :GOSUB 2000 

660 IF DN=0 THEN 300 

670 CLS:PRINT CHRS (23 ) : PRINT8522, "END OF LISTING. . ." 

680 W$=INKEYS:IF W$="" THEN 680 ELSE CLS : END 

1000 IF Y<0 OR Y>99 THEN 1060 

1010 IF FIX(Y/4)*4=Y THEN MO(2)=29 ELSE MO(2)=28 

1020 IF M<1 OR M>12 THEN 1060 ELSE IF D<1 OR D>HO(H) THEN 1060 

1030 Z=0:ER=0:IF M=l THEN 1050 

1040 FOR 1=1 TO M-l:Z=Z+MO(I) :NEXT I 

1050 Z=Z+D:RETURN 

1060 ER=1: PRINT "INVALID DATE" :RETURN 

2000 PRINT "ENTER LINE NUMBER(S) OF ANY ORBIT(S) TO OBTAIN A PRINTOUT OF" 

2001 PRINT "AZIMUTH AND ELEVATION DATA. IF ENTERING MORE THAN ONE LINE" 

2002 PRINT "NUMBER, SEPARATE NUMBERS WITH A SEMICOLON:"; 

2010 A$="":INPUT A?:IF AS= n " RETURN 

2011 CLS:I=0:FOR N=l TO LEN(AS) :K=ASC(MID$ (A$,N,1) ) 

2012 IF K=>49 AND K<=57 THEN I=I+l:OB(I) =K-48 

2013 NEXT N:IF 1=0 THEN RETURN 
2020 IF DS=1 THEN 2200 ELSE DS=1 

2030 PRINT "ENTER NUMBER CORRESPONDING TO SATELLITE:" 

2031 PRINT " 1. OSCAR 7":PRINT " 2. OSCAR 8" 

2032 PRINT " 3. RS - RS": PRINT " 4. OTHER" 
2040 INPUT SN:IF SN<1 OR SN>4 THEN 2030 

2050 ON SN GOTO 2060,2070,2080,2090 
2060 BR=348.23/RD:HT=910:GOTO 2120 
2070 BR=351/RD:HT=560:GOTO 2120 
2080 BR=8/RD:HT=590:GOTO 2120 
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2090 PRINT:INPUT "SUBPOINT BEARING AT EQX (DEGREES CLOCKWISE FROM NORTH) ";BR:BR= 

2100 PRINT HHPDT "AVERAGE HEIGHT OP ORBIT (STATUTE MILES)";HT 

2120 AS=" SPRINT: INPUT "YOUR LATITUDE (XX. XN OR XX.XS)";AS 

2121 A=VAL(A$):IF A>90 THEN 2124 

2122 IF RIGHT$(AS,1)="N" THEN A=A/RD:GOTO 2200 

2123 if rights (a$,1)="s° then a=-a/rdlgoto 2200 

2124 print "invalid latitude input" :goto 2120 

2200 j=i=ps="**#.# «»•* ,**;*. *'"' 
2210 k=ob(j):cls:print"orbit:";ob$(k);" "; 

2211 IF TM(K)<0 PRINT CHRS(91); ELSE PRINT CHR$(92); 

2212 PRINT TAB(17)"EQX: " jPD$ (K) I " AT ";PTf (K) ' „ nPf . OPP5 . 

2213 PRINT " AT ";:PRINT USING "*»#. I";PL(K) ; :PRINT DEGREES 
2220 OL(K)=OL(K)/RD:TM=TM(K) :IR=0:PRINT 

2230 PRINT" TIME"iTAB(14)"LAT. LONG. " ;TAB<33) "AZIMUTH" ; 

2231 PRINT TAB(45)"ELEV.";TAB(57) "RANGE" 

2232 FOR N=l TO 63:PRINT "=";:NEXT N:PRINT 

2240 X=COS(BR)*SIN(6.2B32*TM/OP) 

2241 IF X<=-1 THEN LT--1 .5708 sGOTO 2250 

2242 IF X=0 THEN LT=0:GOTO 2250 

2243 IF X=>1 THEN LT=1. 5708: GOTO 2250 

2244 LT=ATN(X/SQR(-X*X+11) 

2250 X=COS(6.2832*TM/OP)/COS(LT):GOSUB 3000 

2251 IF LT<0 THEN Z=-Z 

2252 IF BR<3.1416 THEN Z=-Z 

2253 LN=Z+.0043633*TM+OL(K) :IF LN=>6.2832 THEN LN=LN-6.2832 

2254 IF LN<0 THEN LN=LN+6.2832 

2260 L=B-LN:IF L<-3.1416 THEN L=L+6.2832 

2261 IF L>3.1416 THEN L=L-6.2832 

2270 X=SIN(A)*SIN(LT)+COS(A)*COS(LT)*COS(L) 

2271 GOSUB 3000:AS=Z 

2280 X= ( SIN ( LT) -SIN ( A) *COS (AS) ) / (COS (A) *SIN (AS) ) 

2281 GOSUB 3000:AZ=Z:IF L<0 THEN AZ=6.2832-AZ „„„,, 
2290 EL=l!5708-ATN((3957 + HT)*SIN(AS)/((3957+HT)*COS(AS)-3957)) 
2300 RG=(( 3957 +HT) *COS (AS) -3957) /COS (1.5708-EL) 

2310 IF EL>1.5708 AND IR=1 THEN 2370 

2320 IF TM=>OP PRINT "NOT IN RANGE THIS PASS" :GOTO023 80 
2330 IF EL>1.5708 THEN 2360 ELSE IR=1 

2340 PT=OT(K)+TM:IF PT=>1440 THEN PT=PT-1440 ,„„„„, „ . 

2341 H=FIX PT/60) :M=FIX(PT)-H«60:PT$=STR$ (H*100+M+10000H" : " 

2342 S=FIX((PT-FIX(PT) )*60+100. 5) :SS=RIGHT?(STR$(S), 2) +"Z" 

2343 PT$=RIGHT$(PT$+S$,8):LT=FIX(LT*RD*10)/10 

2350 PRINT PTS;TAB(13);:PRINT USING "}#. 8" ;ABS(LT) ; 

2351 IF LT<0 PRINT "S"; ELSE IF LT>0 PRINT "N" ; 

2352 PRINT TAB(22) ; :PRIMT USING P$;LN*RD; AZ*RD; E1*RD;RG 
2360 TH=TM+2:GOTO 23<0 

■>-\ia PRINT " END OF PASS. . ."; 

2375 PRINT:PRINT "HIT " ;CHRS (34) ; "ENTER" ;CHR$ (34) ; " TO CONTINUE" 

2380 W$=INKEY$:IF W$="" THEN 2380 

2390 J=J+1:IF J>I RETURN ELSE 2210 

3000 IF X<=-1 THEN Z=3.1416:GOTO 3040 

3010 IF X=0 THEN Z=1.5708:GOTO 3040 

3020 IF X=>1 THEN Z=0:GOTO 3040 

3030 Z=-*ATN(X/SQR(-X*X+1) 1+1.5708 

3040 RETURN 
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SIMULATED FCC ADVANCED CLASS AMATEUR TEST 
(PART I): by Maurice Prather 



Our Advance Test (Part I) pro- 
gram allows your TRS-80 to 
become a friendly FCC ex- 
aminer. The program will guide 
you through some general and 
advanced theory sections of the 
test while prompting you for cor- 
rect answers all the way. Make a 
mistake and you'll be gently chid- 
ed, as well as quickly corrected. 
Features a multiple choice format 
and no 30 day waiting period for 
retest. 
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HATE 
FCC 



U R 

TYPE 



ADVANCED 
EXAMINATION : : : : 



5 CLS:REM ::::::::: A 
10 REM ::::::::: 

50 NT=25:NR=25 

75 CLS:FORX=19TO112:SET(X,0) :SET(X,11) :NEXT X 

80 FORY=0TO11:SET(19,Y) :SET(20,Y) :SET(112,Y) :SET(111,Y> :NEXTY 

85 PRINT88l,"A MATEUR ADVANCE D" ; : PRINT6151 , "FCC TYPE EXAMINATION" 

:FORX=1TO250:NEXTX:GOSUB 10000 
100 CLS:PRINT"PROPAGATION ON THE VHF BANDS USUALLY TAKES PLACE BY THE:" 
110 PRINT:PRINTTAB(10)"1) SURFACE WAVE" 
120 PRINTTAB(10)"2) SKY WAVE" 
130 PRINTTAB(10)"3) SPACE WAVE" 
140 PRINTTAB(10)"4) TROPOSPHERIC REFLECTION" 
150 PRINTTAB(10)"5) IONOSPHERIC REFRACTION" 

160 INPUT Z:IF Z=3 PRINT'CORRECT" :FORX=1TO1000:NEXTX:GOTO200 
170 IFZO3PRINT"WR0NG,THE CORRECT ANSWER IS: 3)THE SPACE WAVE" :GOSUB5000 
200 CLS: PRINT"TRANSIBNT IONIZATION CLOUDS IN WHAT LAYER MAKE POSSIBLE" 
210 PRINT"OCCASIONAL TRANSMISSIONS ABOVE THE 'MUF'" 
220 PRINT:PRINTTAB(10)"1) B 
230 PRINTTAB(10)"2) C 
240 PRINTTAB(10)"3) F 
250 PRINTTAB(10)"4) E 
260 PRINTTAB(10)"5) D 

270 INPUTZ:IFZ=4PRINT"CORRECT":FORX=1TO1000:NEXTX:GOTO300 
280 IFZO4PRINT"WR0NG,THE CORRECT ANSWER IS: 4) THE E LAYER" :GOSUB5000 
300 CLS:PRINT"WHEN YOU COMMUNICATE WITH A STATION 400 MILES EAST OF YOU," 
310 PRINT"YOU FIND THAT BOTH STATIONS MUST POINT THEIR ANTENNAS DUE" 
320 PRINT"NORTH FOR MAXIMUM SIGNALS - WHY?" 
330 PRINT:PRINTTAB(10)"1) BACKSCATTER 
340 PRINTTAB(10)"2) ONE-WAY PROPAGATION 
350 PRINTTAB(10)"3) SUPER-REFRACTION 
360 PRINTTAB(10)"4) SPORADIC E-LAYER PROPAGATION 
370 PRINTTAB(10)"5) ATMOSPHERIC ABSORPTION 
3 80 INPUTZ:IFZ=1PRINT"RIGHT":FORX=1TO1000:NEXTX:GOTO400 

385 IFZOlPRINT"WR0NG,THE CORRECT ANSWER IS: 1) BACKSCATTER" :GOSUB5000 
400 CLS:PRINT"PROPAGATION CONDITIONS USUALLY RE-OCCUR EVERY:" 
410 PRINT:PRINTTAB(10) "1) 30 DAYS" 
420 PRINTTAB(10)"2) 27 DAYS" 
430 PRINTTAB(10)"3) 37 DAYS" 
440 PRINTTAB(10)"4) 79 DAYS" 
450 PRINTTAB(10)"5) 14 DAYS" 
460 INPUT Z:IFZ=2PRINT "THAT' 
470 IFZ02PRINT "NO, THE CORRECT ANSWER IS: 
500 CLS: PRINT" IONOSPHERIC ABSORPTION" 

510 PRINT:PRINTTAB(10)"1) CAUSES WEAKENING OF SIGNALS" 
520 PRINTTAB(10) "2) IS MAINLY CAUSED BY THE D-LAYER" 

530 PRINTTAB(10) "3) VARIES INVERSELY TO THE SQUARE OF THE FREQUENCY" 
540 PRINTTAB(10)"4) INCREASES WITH IONIZATION INTENSITY" 
550 PRINTTAB(10)"51 ALL OF THE ABOVE" 

560 INPUTZ:IFZ=5PRINT"VERY GOODI " :FORX=1TO1000 :NEXTX:GOTO600 
570 IFZO5PRINT"INC0RRECT, THE ANSWER IS: 5) ALL OF THE ABOVE" :GOSUB50 
600 CLS:PRINT"MAXIMUM USABLE FREQUENCY (MUF) DOES NOT DEPEND ON:" 



CORRECT" :FORX=1TO1000:NEXTX:GOTO500 
2) 27 DAYS":GOSUB5000 
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610 PRINT:PRINTTAB(10)"1) TYPE OF TRANSMISSION USED" 
620 PRINTTAB(10)"2) TIME OF THE YEAR" 
630 PRINTTAB(10)"3) TIME OF THE DAY" 
640 PRINTTAB(10)"4) SUN SPOT ACTIVITY" 
650 PRINTTAB(10)"5) NONE OF THE ABOVE" 

660 INPUTZ:IFZ=1PRINT "CORRECT" :FORX=1TO1000:NEXTX:GOTO700 

670 IFZOlPRINT'wRONG, THE RIGHT ANSWER IS: 1) TYPE OF TRANSMISSION USED":GOSUB 
5000 

700 CLS:FORX=5TO30:SET(X,4) :NEXTX:FORY=3T05:SET(31,Y) :SET(33,Y) :NEXTY:FORX=34T06 

3:SET(X,4) :NEXTX:FORY=3T05:SET(64,Y) :SET(66,Y) :NEXTY:FORX=67T096 :SET(X,4) :N 
EXTX:FORY=3T05:SET(97,Y) :SET(99,Y) :NEXTY:FORX=100TO120:SET(X,4) :NEXTX 

701 FORY=5TO10:SET(5,Y) :SET(120,Y) :NEXTY:FORX=5T015:SET(X,ll) :NEXTX:FORX=110TO12 

0"SET(X 11) *NEXTX 

702 PRiNT615!"16UF";:PRINTe31,"8 UF" ,• :PRINT648, "16 UF"; 

703 PRINT6206 , "C-l" ; : PRINTS223 , "C-2" ; :PRINT8239 , "C-3" ; :FORX=1TO250 :NEXTX 
705 PRINT8320,"WHAT IS THE TOTAL CAPACITANCE OF THE ABOVE CIRCUIT:" 

710 PRINT:PRINTTAB(10)"1) 8 UF 2) 1.6 UF 3) 40 UF" 

715 PRINTTAB(10)"4) 4 UF 5) 32 UF" 

760 INPUTZ:IFZ=4PRINT"YOU GOT IT1 ":FORX=1TO1000:NEXTX:GOTO800 

770 IFZO4PRINT"WR0NG, THE CORRECT ANSWER IS: 41 4 UF" :GOSUB5000 

800 CLS:PRINT"UPPER ATMOSPHERIC IONIZATION DEPENDS MAINLY ON RADIATION FROM:" 

810 PRINT!PRINTTAB(10)"1) OUTER SPACE" 

820 PRINTTAB(10)"2) THE SUN" 

830 PRINTTABU0) "3) THE MILKY-WAY" 

840 PRINTTABU0) "4) THE MOON" 

850 PRINTTAB(10)"5) THE eARTH" 

860 INPUTZ:IFZ=2PRINT"EXCELLENT":FORX=1TO1000:NEXTX:GOTO 900 

870 IFZO2PRINT"WR0NG, THE CORRECT ANSWER IS: 2) THE SUN" :GOSUB500O 

900 CLS:PRINT"FOR SUCCESSFUL EARTH-MOON-EARTH (EME) CONTACTS, WHICH OF" 

910 PRINT"THE FOLLOWING ARE NEEDED:" 

920 PRINT:PRINTTAB(10)"1) HIGH GAIN ANTENNA" 

930 PRINTTAB(10)"2) EXCELLENT RECEIVER SENSITIVITY" 

940 PRINTTAB(10)"3) HIGH POWER TRANSMITTER" 

950 PRINTTAB(10)"4) NARROW BANDWIDTH RECEIVER FILTER" 

960 PRINTTAB(10)"5) ALL OF THE ABOVE" 

970 INPUTZ:IFZ=5PRINT "VERY GOOD1 " :FORX=1TO1000 :NEXTX:GOTO1000 

980 IFZO5PRINT"Y0U MISSED ITI, THE CORRECT ANSWER IS: 5) ALL OF THE ABOVE" :GOSU 

B5000 
1000 CLS:PRINT"TV FRONT-END OVERLOADING CAUSED BY 80 THRU 10 METER" 
1010 PRINT"AMATEUR SIGNALS CAN BE ELIMINATED BY:" 
1020 PRINT:PRINTTAB(10)"1) A WAVE-TRAP IN TV FEED LINE" 
1030 PRINTTABU0) "2) A WAVE-TRAP IN TRANSMITTER FEED LINE" 
1040 PRINTTAB(10)"3) USING A HIGH-PASS FILTER ON TV" 
1050 PRINTTAB(10)"4) USING A HIGH-PASS FILTER ON TRANSMITTER" 
1060 PRINTTAB(10)"5) USING AN RF MODULATOR ON TV" 

1070 INPUTZ:IFZ=3PRINT "RIGHT YOU AREI " :FORX=1TO1000 :NEXTX:GOTO1100 
1080 IFZO3PRINT"WR0NG, THE CORRECT ANSWER IS: 3) USING A HIGH-PASS FILTER" 
1085 PRINT"ON THE TV" :GOSUB5000 

1100 CLS:PRINT"TO BE EFFECTIVE, A LOW-PASS TRANSMITTER FILTER NEEDS:" 
1110 PRINT:PRINTTAB(10)"1) TRANSMITTER FEED LINE WAVE-TRAPS" 
1120 PRINTTAB(10)"2) HIGH-PASS RECEIVER FILTER" 
1130 PRINTTAB(10)"3) CLASS C FINAL AMPLIFIER" 
1140 PRINTTAB(10)"4) TRANSMITTER CABINET SHIELDING" 
1150 PRINTTAB(10)"5) TRANSMITTER CABINET CROSS-HATCHING" 
1160 INPUTZ:IFZ=4PRINT "RIGHT" :FORX=1TO1000:NEXTX:GOTO1200 
1170 IFZO4PRINT"WR0NG, THE RIGHT ANSWER IS: 4) TRANSMITTER CABINET SHIELDING" :G 

OSUB5000 
1200 CLS:PRINT"DIAGONAL LINES ON THE TV SCREEN CAUSED BY RADIO INTERFERENCE AREC 

ALLED:" 
1210 PRINT:PRINTTAB(10)"1) iNTERMODULATION LINES" 
1220 PRINTTAB(10)"2) COLOR BARS" 
1230 PRINTTAB(10)"3) CROSS HATCHING" 
1240 PRINTTAB(10)"4) TRANSMISSION LINES" 
1250 PRINTTABU0)"5) HARMONIC LINES" 

1260 INPUTZ:IFZ=3PRINT"YOU'RE RIGHTI " :FORX=1TO1000 :NEXTX:GOTO1300 
1270 IFZ03PRINT" INCORRECT, THE RIGHT ANSWER IS: 3) CROSS HATCHING" :GOSUB5000 
1300 CLS:PRINT"THE RULES DEFINE A REPEATER STATION AS:" 

1310 PRINT:PRINTTAB(10)"1) A STATION TO AUTOMATICALLY RETRANSMIT SIGNALS FOR" 
1315 PRINTTAB(101" THE PURPOSE OF EXTENDING THEIR RANGE" 
1320 PRINTTAB(10)"2) A STATION ONLY FOR RELAYING SIGNALS BETWEEN TWO" 
1325 PRINTTABU0)" SPECIFIC STATIONS" 

1330 PRINTTAB(10)"3) A SEPERATE STATION FOR RADIO CLUB MEMBERS ONLY" 
1340 PRINTTAB(10)"4) a REMOTE CONTROL STATION FOR ANOTHER STATION" 
1350 PRINTTAB(10)"5) A STATION LICENSED FOR A LAND LOCATION, OTHER" 
1355 PRINT TAB(10>" THAN THE PRIMARY STATION" 
1360 INPUTZ : IFZ=1PRINT"0KAY ! " : FORX=1TO1000 :NEXTX:GOTO1400 

1370 IFZOlPRINT"WR0NG, THE CORRECT ANSWER IS: 1) A STATION TO AUTOMATICALLY" 
1375 PRINT"RETRANSMIT SIGNALS FOR THE PURPOSE OF EXTENDING THEIR RANGE" :GOSUB500 


1400 CLS:PRINT"WHICH OF THE FOLLOWING, REGARDING CONTROL STATION AND" 
1405 PRINT"REPEATER OPERATION IS CORRECT:" 

1410 PRINT:PRINTTAB(10)"1) tRANSMISSIONS MUST BE ABOVE 146MHZ" 
1420 PRINTTAB(10) "2) A REPEATER MUST NOT RECEIVE AND TRANSMIT ON" 
1425 PRINTTAB(10)" DIFFERENT BANDS" 
1430 PRINTTAB(10)"3) A SYSTEM NETWORK DIAGRAM FOR EACH SYSTEM OF WHICH" 

1435 PRINTTABU01" THE STATION IS A PART MUST BE INCLUDED IN THE" 

1436 PRINTTABU0)" CONTROL STATION LOG BOOK" 
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1440 PRINTTAB(10)"4) ANY AMATEUR STATION MAY RETRANSMIT SIGNALS IF A" 

1445 PRINTTAB(10)" CONTROL OPERATOR IS PRESENT" 

1450 PRINTTAB(10)"5) A REPEATER MAY TRANSMIT 24 HOURS DAILY - EVEN WITH" 

1455 PRINTTAB(10)" NO SIGNALS BEING RECEIVED" 

1460 INPUTZ:IFZ=3PRINT"YO0 GOT IT" : FORX=1TO1000 :NEXTX:GOTO1500 

Wio ll^Jl^JV^ ^' THE MGHT ANSWER IS: 3 > A SYSTEH NETWORK DIAGRAM" 
1472 PRINT"FOR EACH SYSTEM OF WHICH THE STATION IS A PART, MUST" 
1475 PRINT"BE INCLUDED IN THE CONTROL STATION LOG BOOK" :GOSUB5000EDIT1470-1500 
1500 CLS:PRINT"A REPEATER TRANSMITTER INPUT POWER LIMIT IS- • 
1510 PRINT:PRINTTAB(10)"1) 1,000 WATTS" 

1520 PRINTTAB(10)"2) DEPENDENT UPON FREQUENCY, ANTENNA HEIGHT AND TYPE" 
1530 PRINTTAB(10)"3) 900 WATTS IF PLATE INPUT ISN'T ACCURATELY MEASURED" 
1540 PRINTTAB<10)"4) MINIMUM NECESSARY TO CARRY OUT COMMUNICATIONS" 
1550 PRINTTAB(10)"5) ALL OF THE ABOVE" 

1560 INPUTZ:IFZ=5PRINT"GOOD":FORX=1TO1000:NEXTX:GOTO1600 
1570 IFZO5PRINT"WR0NG, THE ANSWER IS: 5) ALL THE ABOVE" :GOSUB5000 
1600 CLS:PRINT"REPEATER OPERATION IS NOT LEGAL ON THE FOLLOWING WHICH" 
1605 PRINT"FREQUENCY PAIRS" 

1610 PRINT:PRINTTAB(10)»1) 447.25 INPUT / 442.25 OUTPUT" 
1620 PRINTTAB(10)"2) 146.90 INPUT / 147.50 OUTPUT" 
1630 PRINTTAB(10)"3) 146.34 INPUT / 146.94 OUTPUT" 
1640 PRINTTAB(10)"4) 144.34 INPUT / 144.94 OUTPUT" 
1650 PRINTTAB(10)"5) 222.34 INPUT / 223.94 OUTPUT" 
1660 INPUTZ:IFZ=4PRINT"VERY GOOD1 " :FORX=1TO1000 :NEXTX:GOTO1700 

1670 IFZO4PRINT"WR0NG, THE ANSWER IS: 4) 144.34 INPUT / 144.94 OUTPUT" :GOSUB500 
a 

1700 CLS:PRINTe94,CHR?(153);:FORX=10TO59:SET(X,2):NEXTX:FORX=51TO59:SET(X,6):NEX 
TX:PRINTei58,CHR$(164);:PRINT9222,CHR$(145);:FORX=51TO59:SET(X,10):NEXTX:PR 

T059?SET™1B)-NEXT^^ 

1701 FORY=3TO5:SETU0,Y) :NEXTY:FORY=15TO18:SET(10,Y) :NEXTY 

1702 PRINT@132,CHR$(130);CBRS(135);:PRINTe260,CHR$(160);CHR$(180),-:FORY=3TO8-SET 

(29,Y):NEXTY:FORY=12TO17:SET(29,Y):NEXTY:FORX=28TO30:SET(X,9):SET(X,11):NEX 
TX:PRINT@195, "POWER"; 

1703 J R I™ 8 ??f' CHR5(16a > ;!PRINM289 -CHR$(137);:PRINTH53,CHRS(166);:FORX=68T075: 
SET(X,14):NEXTX:FORX=68TO105:SET(X,18):NEXTX:FORX=68TO75:SET(X,10):NEXTX-FO 
RY=3TO10:SST(75,Y):SET(76,Y):NEXTY:FORX=75TO105:SET<X,2):NEXTX 

1704 FORX=90TO120:SET(X,7) :SET(X,14) :NEXTX:FORY=3T07 :SET(104 ,y) :SET(105,Y) -NEXTY 
:FORY=15TO18:SET(104,Y) :SET(105,Y) :NEXTY:FORY=7T014 :SET(90 , Y) :SET(89,Y) : SET 
(119, Y) :SET(120,Y) :NEXTY 

1705 PRINTe266,"C-l";:PRINT8278,"L-l";:PRINTe295,"L-2";:PRINT§242,"LOAD";:FORX=l 

1706 PRINT6450,"WHAT TYPE COUPLING IS USED IN THIS CIRCUIT-" 

1710 PRINT:PRINTTAB(10)"1) LINKING 2) IMPEDENCE 3) CAPACITIVE" 

1720 PRINTTAB{10)"4) RADIO FREQUENCY 5) INDUCTIVE" 

1760 INPUTZ:IFZ=5PRINT"YOU'RE RIGHT1 " :FORX=1TO1000 :NEXTX:GOTO1800 

1770 IFZO5PRINT"S0RRY, THE ANSWER IS: 5) INDUCTIVE" :GOSUB5000 

1800 CLS:PRINT"UNDER WHAT CONDITIONS IS A-M TELEVISION ALLOWED IN THE" 

1805 PRINT"AMATEUR HF BANDS:" 

1810 PRINT:PRINTTAB(10)"1) FM TV (F-5) MAY NOT BE USED" 

1820 PRINTTAB(10)"2) TOTAL BANDWIDTH CAN'T EXCEED AN A-3 SSB SIGNAL" 

1830 PRINTTAB(10)"3) IF A DSSB TRANSMITTER IS USED, THE CARRIER MUST BE" 

1835 PRINTTAB(10)" SUPPRESSED AND INFORMATION MUST BE THE SAME IN" 

1836 PRINTTABU0)" BOTH SIDEBANDS" 

1840 PRINTTAB(10)"4) TOTAL BANDWIDTH CAN'T EXCEED 6 KHZ" 

1850 PRINTTAB(10)"5) A SSB SUPPRESSED CARRIER TRANSMITTER IS REQUIRED" 

1860 INPUTZ:IFZ=2PRINT"GOODI":FORX=1TO1000:NEXTX:GOTO1900 

J»7? J=?2^ R H^' 1 ' 00 BA ?' ™ E RIGHT ANSWER IS: 2 > T0TAL BANDWIDTH CAN'T" 

1875 PRINT-EXCEED AN A-3 SSB SIGNAL" :GOSUB5000 

1900 CLS:PRINT"YOUR TRANSMITTER HAS A 50 OHM OUTPUT IMPEDENCE WHICH" 

1905 PRINT"OF THESE ANTENNAS WILL PROVIDE THE BEST MATCH-" 

1910 PRINT:PRINTTAB(10)"1) ZEPP END-FED WITH 1/2 WAVE TRANSMISSION LINE" 

1920 PRINTTAB(10)"2) END-FED ZEPP" 

1930 PRINTTAB(10)«3) HORIZONTAL 1/2 WAVE END-FED WIRE" 

1940 PRINTTAB(10)"4) FOLDED, FLAT-TOP 1/2 WAVE, FEED WITH A 700 OHM" 

1945 PRINTTAB(10)" 1/2 WAVE TRANSMISSION LINE" 

1950 PRINTTAB(10)"5) A 5/8 VERTICAL" 

1960 INPUTZ:IFZ=3PRINT"RIGHT":FORX=1TO1000:NEXTX:GOTO2000 

1970 ""^PRINT-WRONG - THE ANSWER IS: 3) HORIZONTAL 1/2 WAVE END-FED WIRE":GOS 
UB5000 

2000 CLS:PRINT"HOW MANY PARASITIC ELEMENTS IN A 5 ELEMENT YAGI BEAM-" 

2010 PRINT:PRINTTAB(10)"1) NONE" 

2020 PRINTTAB(10)"2) 4 ELEMENTS" 

2030 PRINTTAB(10)"3) 3 ELEMENTS" 

2040 PRINTTAB(10)"4) 1 ELEMENT" 

2050 PRINTTAB(10)"5) 2 ELEMENTS" 

2060 INPUTZ:IFZ=2PRINT"RIGHT YOU ARE":FORX=1TO1000:NEXTX:GOTO2100 

2070 IFZO2PRINT-INC0RRECT - THE ANSWER IS: 2) FOUR ELEMENTS" :GOSUB5000 

2100 CLS:PRINT"THE RHOMBIC ANTENNA'S CHIEF DISADVANTAGE IS-" 

2110 PRINT:PRINTTAB(10)"1) IT COST TOO MUCH" 

2120 PRINTTAB(10)"2) GAIN TOO LOW" 

2130 PRINTTABU0) "3) BEAM WIDTH TOO BROAD" 

2140 PRINTTAB(10>"4) TOO DIFFICULT TO ROTATE" 

2150 PRINTTAB(10)"5) ALL OF THE ABOVE DISAVANTAGES" 

2160 INPUTZ:IFZ=4PRINT"VERY GOOD1 " :FORX=1TO1000 :NEXTX:GOTO2200 

ll 1 ! I1?z <>4 p RINT"WRONG - THE ANSWER IS: 4) TOO DIFFICULT TO ROTATE" :GOSUB 5000 

2200 CLS: PRINT-WHEN RESONANT AT 7.06 MHZ, WHAT IS THE LENGTH OF A 1/4 WAVE" 
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2205 PRINT"RG8/U COAXIAL CABLE TRANSMISSION LINE. (ITS VELOCITY FACTOR" 

2207 PRINT-IS .66) : " 

2210 PRINTTAB(10)"1) 23 FEET" 

2220 PRINTTAB(10)"2) 129 FEET" 

2230 PRINTTAB(10)"3) 94 FEET" 

2240 PRINTTAB(10)"4) 47 FEET" 

2250 PRINTTAB(10)"5) 36.5 FEET" 

2260 INPUTZ:IFZ=1PRINT"RIGHT":FORX=1TO1000:NEXTX:GOTO2300 

2270 IFZOIPRINT'WRONG - THE ANSWER IS: 1) 23 FEET" :GOSUB5000 

2300 CLS:PRINT"THE DISTANCE BETWEEN THE HALF POWER POINTS OF VERTICAL OR" 

2305 PRINT"HORIZONTAL RADIATION PATTERNS OF AN ANTENNA ARE CALLED:" 

2310 PRINT:PRINTTAB(I0)"1) BEAM WIDTH" 

2320 PRINTTAB(10)"2) MINOR LOBE" 

2330 PRINTTAB(10)"3) FEED POINTS" 

2340 PRINTTAB(10)"4) ZERO-DB REFERENCE POINTS" 

2350 PRINTTAB(10)"5) NONE OF THE ABOVE" 

2360 INPUTZ : IFZ=1PRINT"RIGHT" :FORX=1TO1000. ■ NEXTX :GOTO2400 

2370 IFZOlPRINT"S0RRY, THE RIGHT ANSWER IS: 1) BEAM WIDTH" :GOSUB5000 

2400 CLS:PRINT"WHICH ANTENNA IS UNIDIRECTIONAL:" 

2410 PRINT:PRINTTAB(10)"1) INVERTED VEE" 

2420 PRINTTAB(10)"2) DIPOLE" 

2430 PRINTTABU0) "3) LONG WIRE" 

2440 PRINTTAB(10)"4) UNTERMINATED RHOMBIC" 

2450 PRINTTAB(10)"5) TERMINATED RHOMBIC" 

2460 INPUTZ:IFZ=5PRINT"CORRECT":FORX=1TO1000:NEXTX:GOTO2500 

2470 IFZO5PRINT"WR0NG - THE ANSWER IS: 5) TERMINATED RHOMBIC " :GOSUB5000 

Hit bd™?, 1 ,??,"^ n 3 MHZ SIGNM " ™ E LENG ™ OF YOUR 1/2 WAVE DIPOLE ANTENNA" 
2505 PRINT WILL BE: 

2510 PRINT:PRINTTAB(10|"1) 163 FEET" 

2520 PRINTTAB(10)"2) 156 FEET" 

2530 PRINTTAB(10)"3) 17 3.4 FEET" 

2540 PRINTTAB(10)"4) 133 FEET" 

2550 PRINTTAB(10)"5) 147 FEET" 

2560 INPUTZ : IFZ=2PRINT"OKAY ! " : FORX=1TO1000 : NEXTX :GOTO3000 

2570 IFZO2PRINT"Y0U'RE WRONG - THE ANSWER IS: 2) 156 FEET" : FORX=1TO1000 • NEXTX 

2575 PRINT:PRINT"WHEN READY TO CONTINUE, PRESS ' ENTER' ",: INPUT Q: GOTO3000 

3000 CLS:PRINT@276,CHRS(23) "TEST FINISHED" :FORX=1TO1000:NEXTX:GOTO20000 

5000 PRINT:FORX=1TO1500:NEXTX:NR=NR-1 

5004 INPUT"WHEN READY TO CONTINUE PRESS ENTER" ;Q:RETURN 

10000 PRINTS320,"THIS IS A COMPUTER ASSISTED INSTRUCTIONAL (CAI) PROGRAM " 

10001 PRINT"DESIGNED TO HELP PREPARE YOU TO TAKE THE FCC ADVANCED AMATEUR" 

10002 PRINT"LICENSE TEST. THIS IS A SIMULATION AND THESE QUESTIONS ARE" 

10003 PRINT"NOT THE ACTUAL ONES THAT WILL BE ON YOUR TEST, RATHER THEY" 

10004 PRINT"ARE SIMILIAR TO THOSE ON THE ACTUAL TEST AND WILL GIVE YOU" 

10005 PRINT'A GOOD IDEA AS TO THE TYPE MATERIAL WHICH WILL BE COVERED " 

10006 PRINT"IF YOU HAVE DIFFICULTY WITH A PROBLEM, OR GROUP OF PROBLEMS," 

10007 PRINT"REFER TO THE APPROPRIATE SECTIONS IN YOUR STUDY MANUAL " 

10008 PRINT: INPUT"WHEN READY TO CONTINUE PRESS ' ENTER' ";Q 

10009 PRINT6320,"THIS PROGRAM IS DIVIDED INTO THREE SECTIONS — EACH SECTION" 

10010 PRINT"CONTAINING 25 QUESTIONS. AFTER STUDYING EACH QUESTION," 

10011 PRINT"CHOOSE ONE OF THE FIVE ANSWERS YOU THINK IS MOST NEARLY" 

10012 PRINT"CORRECT, TYPE IN THE ANSWER NUMBER AND THEN PRESS 'ENTER' " 

10013 PRINT"IF YOUR ANSWER IS CORRECT, THE TRS-80 WILL TELL YOU SO, AND" 

10014 PRINT"MOVE ON TO THE NEXT QUESTION. IF YOUR ANSWER IS WRONG THE" 

10015 PRINT"TRS-80 WILL TELL YOU THE CORRECT ANSWER SO YOU MAY STUDY" 

10016 PRINT"THE QUESTION 5 ANSWER BEFORE MOVING ON." 

10017 PRINT: INPUT"WHEN READY TO CONTINUE, PRESS 'ENTER'. "-Q 

10018 PRINTS320,"AT THE END OF EACH SECTION YOU WILL BE GIVEN THE NUMBER 

10019 PRINT"OF ANSWERS YOU GOT RIGHT, AND YOUR PERCENTAGE CORRECT BE" 

10020 PRINT"SURE AND WRITE DOWN THE NUMBER YOU GOT RIGHT ON SECTIONS 1" 

10021 PRINT"AND 2 SO YOU CAN GET YOUR OVERALL CORRECT PERCENTAGE AT THE" 

10022 PRINT"END OF SECTION 3." 

10023 PRINT: PRINT 

10024 PRINTe896,"WHEN READY TO START TEST, PRESS ' ENTER' ";: INPUTQ- RETURN 

20000 CLS:PRINTS256,"ON THIS SECTION YOU GOT";NR; "RIGHT OUT OF" ;NT; "FOR" • INT ( (N 
R*100/NT)+.5) ;"%" 

20001 PRINT"REMEMBER TO WRITE DOWN THE NUMBER YOU GOT RIGHT. " :FORX=1TO2500 -NEXTX 

20002 PRINT:PRINT"THE FCC REQUIRES AT LEAST A SCORE OF 744 TO PASS THE TEST" 

20003 PRINTTAB(15)"TO GET YOUR ADVANCED LICENSE" : FORX=1TO1000 : NEXTX 

20004 PRINT: INPUT"WHEN READY TO CONTINUE, PRESS 'ENTER'"-Q 

20005 CLS:PRINTS576,"TO PROCEED TO THE SECOND SECTION OF THIS PROGRAM" 

20006 PRINTTAB(10)"TYPE 'CLOAD' AND PRESS ENTER. ":END 
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ANTENNA SYSTEM DESIGN: by Bill Ford 



Designing an antenna system 
for amateur or commercial use? 
The Antenna System Design pro- 
gram will allow you to compare 
several combinations of antennas 
and feedlines in order to deter- 
mine the optimim ERP (Effective 
Radiated Power). In addition, 
the maximum allowable feedline 
loss in dB for a given ERP is also 
determined. 



losses tr caimr uso comm. mm in is per ise ft. 



type iik I8IK uemz nam 'unite 

SGI? .86 .24 .95 2.4 (.4 

K-8 .16 .55 2.8 4.5 8.5 

HI .18 .62 2.2 4.7 8.5 

„,i58 .38 1.4 5.2 11.2 28.8 

RC5? .38 1.1 3.8 8.5 14.8 



vduts ro; other fkomies cm be otaiid sy irawura 

DO YOU IfQ 70 1HTBKUTE FRi* TIC TABLE? _ - • . 



1 CLS 

10 ' * * * FEEDLINE LOSS AND EFFECTIVE RADIATED POWER 

20 t * * . PROGRAM 

30 ' * * * CODED BI BILL FORD. 

41 FORS=1T064:PRINT"=";:NEXTS:PRINT"THIS PACKAGE IS OF PARTICULAR INTEREST TO YO 

D IF YOU AREDESIGNING AN ANTENNA SYSTEM FOR AN AMATEUR OR 

42 PRINT'A COMMERCIAL INSTALLATION. YOU WILL BE ABLE TO COMPAREVARIOUS COMBINAT 

IONS OF ANTENNA - FEEDLINE TYPES TO OBTAIN THE 
MOST PRACTICAL EFFECTIVE RA 

DIATED POWER FOR TYPE OF ANTENNA OR 
FEEDLINE IN PROGRAM /A/. PROGRAM "B 11 

ALLOWS YOU TO" 

43 PRINT-DETERMINE EXACTLY HOW MUCH LOSS IN DB CAN BE ALLOWED 
FOR A PARTICULAR 



EFFECTIVE RADIATED POWER OUTPUT. " : FOR S=l T064:PRINT" 
PRINT 



:NEXTS:PRINT:PRINT: 



44 INPUT"DO YOU WANT TO RUN A OR B";A$:CLS 

45 FOR S=l TO 64:PRINT"=";:NEXT S 

46 IF A$="B"THEN GOTO 10000 

50 PRINT'THIS PROGRAM COMPUTES THE EFFECTIVE RADIATED POWER" 

55 PRINT 

60 PRINT"AS WELL AS THE FEEDLINE LOSS OF ANY TRANSMITTER-" 

65 PRINT 

70 PRINT'ANTENNA SYSTEM. bASED ON TRANSMITTER OUTPUT POWER," 

75 PRINT 

80 PRINT"FEEDLINE AND ANTENNA EFFICIENCY" 

85 FOR S=l TO 64:PRINT"=";:NEXT S 

90 PRINT:PRINT:INPUT"DO YOU NEED INSTRUCTIONS" ;A$ 

100 IF LEFT?(A5,1)="Y" THEN 4000 

102 GOSUB 4070 

110 CLS:INPUT"WHAT IS THE TRANSMITTER OUTPUT POWER";TP 

120 PRINT: PRINT: INPUT"HOW MANY FEET OF FEEDLINE DO YOU PLAN ON USING";FL 

121 ■* * * IF INTERPOLATION WAS USED THE STEP ASKING FOR FEED- 
LINE LOSS IS OMMI 

TTED. WALUE ' LL ■ IS USED DIRECTLY. 
125 IF LLO0 THEN 140 

130 PRINT: PRINT: INPUT"WHAT IS THE LOSS IN DB PER 100 FEET OF YOUR FEEDLINE"-LL 
140 PRINT: PRINT :INPUT"WHAT IS THE GAIN OF YOUR ANTENNA SYSTEM IN DB(IF UNITY GAI 

N DB GAIN IS 0)";AG 
150 '* * * CALCULATE TOTAL LOSS FOR ENTIRE LENGTH OF CABLE 

160 L=FL/100*LL 

161 L1=L 

170 GOSUB 5000 

17 5 PL=P1 

180 ' * * * now CALCULATE EFFECTIVE RADIATED POWER AFTER 

FIRST DETERMINING HOW M 

UCH POWER WILL BE DELIVERED TO ANTENNA 
190 PA=TP-P1 
200 L=AG 
220 GOSUB 5000 
1000 CLS 

1010 PRINT "TRANSMITTER OUTPUT POWER "; TP ; "WATTS " 

1015 PRINT 

1020 PRINT"FEEDLINE LENGTH " ; FL; "FEET" 

1025 PRINT 

1030 PRINT"LOSS/100 FEET ";LL,-"DB" 

1035 PRINT 
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1040 PRINT'DB LOSS OF ENTIRE RUN ";L1;"DB" 

1045 PRINT 

1050 PRINT"POWER LOSS OF ENTIRE RUN "; PA ; "WATTS " 

1055 PRINT 

1060 PRINT"POWER DELIVERED TO ANTENNA ";PL; "WATTS 

106 5 PRINT 

107 PRINT"EFFECTIVE RADIATED POWER "; E; "WATTS" 

1080 PRINT , , 

1100 LL=0:INPUT" DO YOU WANT ANOTHER CALCULATION" ;A$ 

1110 IFLEFT$(AS,1)="Y" GOSUB4070:GOTO110 

2000 GOTO 9999 

4000 CLS:FOR S=l TO 64 : PRINT"=" ; : NEXT S:PRINT"YOU WILL BE ASKED TO ENTER VARIOUS 

OPERATING PARAMETERS 
4010 PRINT"OF YOUR PROPOSED TRANSMITTING SYSTEM. tHESE WILL BE: 
4020 PRINT"TRANSMITTER OUTPUT POWER; LENGTH OF FEEDLINE; FEEDLINE" 
4030 PRINT"LOSS AT OPERATING FREQUENCY IN DB PER 100 FT. , -AND ANTENNA 

4040 PRINT"GAIN IN DB. 

4041 PRINT'ENTER ALL FREQUENCIES IN MEGAHERTZ. FOR YOUR CONVENIENCE, ANABBREVIA 
TED TABLE OF MORE COMMON COAX TYPES AND LOSSES IS 

4042 PRINT"GIVEN.USE THIS TABLE, OR ANY OTHER SIMILAR TABLE FOR 

4043 PRINT"YOUR CALCULATIONS. aN OPTION WHICH ALLOWS YOU TO INTERPOLATEFROM THE 
TABLE IS ALSO INCLUDED." 

4045 FOR S=l TO 64 : PRINT" = " ; : NEXT S 

4050 PRINT:PRINT:INPUT"PRESS /ENTER/ TO CONTINUE" ; AS 

4052 GOSUB 407 

4055 GOTO 110 

4070 CLS:PRINT" LOSSES OF COMMONLY USED COAXIAL CABLE IN DB PER 100 FT." 

4080 PRINT: PRINT 

4085 GOSUB 4090 

4087 GOTO4140 

4090 PRINT"TYPE 1 MHZ 10 MHZ 100 MHZ 400 MHZ 1000 MHZ 

4091 PRINT"RG17 .06 .24 .95 2.4 4.4 
4100 PRINT"RG-8 .16 .55 2.0 4.5 8.5 
4110 PRINT"RG-11 .18 .62 2.2 4.7 8.5 
4120 PRINT"RG58 .38 1.4 5.2 11.2 20.0 
4130 PRINT"RG59 .30 1.1 3.8 8.5 14.0 
4135 RETURN 

4140 PRINT: PRINT"VALUES FOR OTHER FREQUENCIES CAN BE OBTAINED BY INTERPOLATION 

4200 INPUT"DO YOU NEED TO INTERPOLATE FROM THE TABLE";A$ 

4300 IF LEFT$(A$,1)="Y" GOSUB 6000 

4400 RETURN 

5000 '* * * CALCULATE ACTUAL LOSS FROM DB VALUES 

5010 ■* * * FIRST OBTAIN LOG FROM DB BY DIVIDING BY 10 

5020 L=L/10 

5030 '* * * ANTILOG OF "L" 

5040 AL=10 !L 

5050 P1=TP/AL 

5051 E=AL*PL 
5055 RETURN 

6000 ' * * * INTERPOLATION SUBROUTINE 

6010 CLS:PRINT:PRINT:INPUT"WHAT IS OPERATING FREQUENCY" ; OF: CLS 

6015 GOSUB 4090 

6020 PRINT:PRINT:INPUT"WHAT IS CLOSEST FREQUENCY BELOW OPERATING FREQUENCYLISTED 

IN TABLE" ,-LF 

6025 CLS:GOSUB 4090 

6030 PRINT : PRINT : INPUT"WHAT IS THE NEXT HIGHER FREQUENCY LISTED";HF 

6035 CLS:GOSUB 4090 

6040 PRINT:PRINT:INPUT"GIVE LOSS AT NEXT LOWER FREQUENCY" ;L1 

6045 CLS:GOSUB 4090 

6050 PRINT:PRINT:INPUT"GIVE LOSS AT NEXT HIGHER FREQUENCY" ;L2 

6060 FD=HF-LF 

6080 OD=OF-LF 

6090 OL=OD*LD/FD 

7000 LL=OL+Ll 

7010 CLS: PRINT-LOSS OF TRANSMISSION LINE AT";OF;"MHZ IS";LL;"DB / 100 FEET." 

7020 FOR W=1TO1500:NEXT W 

7030 RETURN 

9999 END 

10000 PRINT"THE FIRST PART OF THIS SECTION ALLOWS YOU TO ENTER 
THE TRANSMITTER 

OUTPUT POWER AND THE EFFECTIVE RADIATED POWER 
YOU DESIRE. YOU WILL THEN GE 

T THE GAIN NEEDED TO OBTAIN THIS 
ERP. IN THE SECOND PART YOU WILL ENTER TH 

E POWER 

10001 PRINT"THAT YOU EXPECT TO BE DELIVERED TO THE ANTENNA. YOUWILL THEN GET T 
HE MAXIMUM ALLOWABLE LOSS IN YOUR FEEDLINE." 

10005 F0RS=1T064:PRINT"=";:NEXTS:INPUT"D0 YOU WANT TO FIND REQUIRED SYSTEM GAIN 
(DOR MAXIMUM ALLOWABLE FEEDLINE LOSS (2)";T 

10006 INPUT"WHAT IS YOUR TRANSMITTER POWER OUTPUT" jPl : IF T=2 THEN GOTO 10500 

10019 INPUT"WHAT IS YOUR DESIRED EFFECTIVE RADIATED POWER";E 

10020 GOSUB 10030 
10025 GOTO 10050 
10030 EL=E/P1 

10040 D=10*(LOG(EL)/LOG(10)) 
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10041 RETURN 

10050 CLS:PRINT "THE REQUIRED GAIN OF YOUR SYSTEM IS" ;D; "DB. » 

10051 GOTO 11000 

10500 E=0: INPUT"HOK MUCH POWER DO YOU EXPECT TO DELIVER TO THE 

ANTENNA" ; E 

10510 GOSUB 10030 

10520 CLS:PRINT"THE MAXIMUM ALLOWABLE FEEDLINE LOSS TO MAINTAIN" ;E; "WATTS TO THE 

ANTENNA WITH A TRANSMITTER POWER OUTPUT OF" ; PI; "IS" ;D; "DB. " 
11000 PRINT:PRINT:PRINT:PRINT:PRINT: INPUT "DO YOU WANT TO: 
1 RUN PROGRAM 'A' 

THE EFFECTIVE RADIATED POWER PROGRAM. 2— RUN PROGRAM 'B' THE MAXIMUM AL 

LOWABLE LOSS PROGRAM 
3— TERMINATE THIS SESSION— ";W 
11010 CLS:FOR S=T TO 64:PRINT"=" ; :NEXT S:ON W GOTO 50,10000,30000 

30000 PRINT:PRINT:PRINT"* * * * * bye * * * * *" : PRINT: PRINT: PRINT 

30001 FOR S=1T064:PRINT"=";:NEXT S 

30002 END 



OSCAR TELEMETRY PROGRAM: by Mark Herro 



Keep track of Oscar telemetry 
parameters with this program. 
Supply orbit number, frame 
number, the date and frequency 
of channels, and the program will 
tell you such things as solar array 
current, battery current and 
voltage, baseplate temperature 
and mode J power in milliwatts. 
Good for Oscars seven and eight. 




999 ' INITIALIZATION 

1000 DEFINT A-X:DEFSNG Y:DEFSTR Z:DIM T(24) ,Y(18) : ZF=STRING$ (32,61) 
1010 G=0:CLS:PRINTCHRS(23);ZF;" OSCAR PACKAGE TELEMETRY" 

1020 PRINTZF : PRINT: PRINT"PRESS: " ; TAB (15) "FOR:": PRINT 

1030 PRINT" 7 OSCAR 7" : PRINT: PRINT" B OSCAR 8" 

1040 PRINT:ZI="" 

1050 ZI=INKEYS:IF ZI="" THEN 1050 

1055 IF ZI=CHR$(13) THEN ZI="8" 

1060 IF(ZI="7")+(ZI="8") THEN OS=VAL(ZI) ELSE PRINT"TOUCH 7 OR 8":GOTO 1050 

1070 PRINT"OSCAR";OS:FOR I=1TO300 :NEXTI : IF OS=7 THEN S=24 ELSE S=6 

1080 CLS : PRINTCHR$ ( 23 ) ; TAB ( 10 ) "OUTPUT SELECT" : PRINTZF : PRINT'PRESS : " ; 

1090 PRINTTABU5) "FOR: ": PRINT: PRINT" V VIDEO (NO PRINTER)" 

1100 PRINT" L LINE PRINTER" :PRINT 

1110 PRINT" S SCREEN PRINTER" : PRINT: ZI="" 

1120 ZI=INKEY?:IF ZI="" THEN 1120 

1125 IF ZI=CHRS(13) THEN ZI="V" 

1130 IF(ZI="V")+(ZI="L")+(ZI="S") THEN PS=ASC(ZI) ELSE PRINT"TOUCH V, L, OR S" :G 

OTO1120 
1140 IF ZI = "V" THEN PRINT"VIDEO" ELSE IF ZI="L" THEN PRINTLINE PRINTER" 
1150 IF ZI="S" THEN PRINT"SCREEN PRINTER" 
1160 FOR I=1TO300:NEXTI 

1170 CLS:PRINTCHRS(23) :INPUT"ORBIT »" ;0: PRINT: INPUT"FRAME #";F 
1180 PRINT: INPUT"DATE (MM, DD, YY) " ;M,D,R:CLS : PRINTCHRS (23) 
1190 PRINT"=ENTER= THE LAST TWO DIGITS OF" : PRINT"EACH CHANNEL PER '?'" 
1200 PRINT" (REMEMBER TO ENTER EACH NUMBER" : PRINT" IN THE SAME ORDER AS FROM OSCAR 

)" 
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1210 FOE J = l TO S:INPUT T(J):NEXT J : CLS : PRINTCHRS (23 ) ; : GOTO4000 

1219 ' MAINLINE 

1220 IF OS=7 THEN FOR 1=1 TO 6:READ ZA, ZB, E : NEXTI 
1230 G=G+1:READ ZA,ZB,E 

1240 GOSUB 5000: IF PS=76 THEN LPRINT ZA;Y(E);ZB ELSE PRINT ZA; Y ( E) ; ZB : PRINT 

1250 IF G=S THEN 1300 ELSE IF (G=6) + (G=10 ) + (G=15 ) + (G=20 ) THEN 1260 ELSE 1230 

1260 IF PS=83 THEN OUT 254,255:FOR I=1TO1000 :NEXTI 

1270 IF PS=76 THEN 1230 ELSE PRINT"PRESS (ENTER) TO CONTINUE" ;: ZI=" " 

1280 ZI=INKEYS:IF ZI = "" THEN 1280 

1290 PRINT§192,CHRS(31);:GOTO 1230 

1300 IF PS=83 THEN OUT 254, 255: FOR I=1TO1000 :NEXTI 

1310 IF PS=76 THEN 1330 ELSE PRINT"PRESS (ENTER) TO CONTINUE" ;: ZI=»" 

1320 ZI=INKEY$:IF ZI = "" THEN 1320 

1330 CLS:PRINTC1IRS(23) , -"RESTART PROGRAM (Y OR N)?":ZI = "" 

1340 ZI=IHKEY$:IF ZI = "" THEN 1340 

1350 IF ZI="Y" THEN RUN ELSE CLS : END 

1360 END 

4000 CLS:PRINTCHR$(23) ; 'PRINT HEADING 

4010 IF PS<>76 THEN 4050 

40 20 LPRINTCHR$(30);ZF:LPRINTTAB(5)"OSCAR";OS;TAB(15)"ORBIT";O 

4030 LPRINTTABU0) "FRAME" ; F;TAB ( 20) "8" ;D;M; R: LPRINTZF 

4040 GOTO 1220 

4050 PRINTTABI5) "OSCAR" ;OS; TAB (15 ) "ORBIT";0 

4060 PRINTTAB(10) "FRAME" ; F;TAB ( 20) "6" ;D;H;R: PRINTZF ; 

4070 GOTO 4040 

4080 END 

4999 ' EQUATION SUBROUTINE 

5000 IF T(G)=0 THEN Y ( E) =0 : RETURN 

5010 N=T(G):Y(0)=95.8-1.48*N:Y(1)=7.15*(101~N) : Y ( 2) =57 * (N-50 ) 

5020 Y(3)=.1*N+8.25:Y(4)=23*N:Y(5)=1970-20*N:Y(6)=29.5*N 

5030 Y(7)=8*(1-.01*N) [2:Y(8)=.253*N:Y(9)=40*(N-50) : Y(10) =.l*N+6 . 4 

5040 Y(11)=.1*N:Y(12)=.15*N:Y(13)=11.67*N:Y(14)=11+.82*N 

5050 Y(15)=N[2/1.56:Y(16)».1*N(2+35:Y(17)=.041*N[2:Y(18)=.01*N 

5060 RETURN 

5070 END 

5999 ' TITLES 

6000 DATA Solar Array Current=,mA, 1 
6005 DATA Battery Current=,mA, 2 
6010 DATA Battery Voltage=,Volts,3 
6015 DATA Baseplate Temp.=,'C,0 
6020 DATA Battery Temp.=,'C,0 

6025 DATA Mode J RF Power=,mW,4 

6030 DATA Solar Array Current=,mA,6 

6035 DATA +X Quadrant Current=,mA, 5 

6040 DATA -X Quad. Current=,mA,5 

6045 DATA +Y Quad. Cur ren t= ,mA, 5 

6050 DATA -Y Quad. Cur rent=,mA, 5 

6055 DATA 70-2 RF Power= ,Wat ts ,7 

6060 DATA Ship Time=,Hours,8 

6065 DATA Charge/Discharge Current- ,mA,9 

6070 DATA Battery Voltage=, Volts, 10 

6075 DATA 1/2 Batt. Voltage-, Volts, 11 

6080 DATA Batt. Regulator 81=, Volts, 12 

6085 DATA Batt. Temp.=,'C,0 

6090 DATA Baseplate Temp. =, 'C, 

6095 DATA 2-10 Transponder Temp.=,'C,0 

6100 DATA +X Facet Ternp.=,'C,0 

6105 DATA +Z Facet Temp.=,'C,0 

6110 DATA 70-2 Transponder Temp.=,'C,0 

6115 DATA 2-10 Emitter Cur rent=,mA, 13 

6120 DATA 70-2 Modulator Temp.=,'C,0 

6125 DATA Switching Currents ,mA,14 

6130 DATA 2-10 RF Power, mW, 15 

6135 DATA 435 MHz Beacon=,mW, 16 

6140 DATA 2304 MHz Beacon=,mW, 17 

6145 DATA Telemetry Calibration-, Volts, 18 

6150 END 
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RADIO LOG PROGRAM: by Darrell Offutt 



This radio log program takes 
the drudgery out of logging, as 
well as giving the busy ham in- 
stant call-up capability by any of 
several priorities, e.g., by call 
sign, state, name, etc. A real time 
and energy saver in the shack. 



mow mm* 

select KSIKJ MMTI« 
: , ° j-flHHT LOG ■..•■; 
' J-SOCUE T1K PERIOD 
3-fSIKI nCCOUMI StltWY 

■'■ 4-aiiT ? e • ■ ' 

: MHO LOG F0R:KT TO SEW A IB) F! 


» UHE €rtl£?(Y/H> 

: -ife ■ 


EHTBi lilt TO $CKHIL£(l«m>:W2B 






16:28 • 


SEC SCOT 


m.* ' ■ 


to vou m to awa this he?? . 







10 REM RADIO LOG 

20 CLEAR 1000 

30 DIM AZ$(300,10),S3(300),S6(300) 

50 DEFINT S,P,H,M,C 

60 OPEN"R",l,"RADIOLOG:l" 

70 IF LOF(1)>0 GOTO 100 

82 PRINT'RADIO LOG FILE ON THIS DISKETTE IS EMPTY" : INPUT"DO YOU WANT TO SETUP A 

NEW FILE?(Y/N)";Y$:IF Y$="N"GOTO 100 

83 IF Y?<>"Y" THEN GOT082:ELSE LINEINPUT"ENTER NAME OF RADIO STATION :" ;NA$ : INPUT 

"ENTER DATE OF THIS LOG:";DT$ 

84 GOSUB 11100:LSET RS$=NAS:LSET DATES=DT$ 
86 LSET CR$=MKI$(1) 

88 FOR SR=0 TO 24:GOSUB 11000:LSET LR$=MKI$ (0) :NEXT SR:PUT1,1 

100 CO$=":" 

110 CLS:PRINT"RADIO LOG PROGRAM" 

120 PRINT"SELECT DESIRED OPERATION" : A* =4 

130 PRINT"1-PRINT LOG" 

140 PRINT"2-SCHEDULE TIME PERIOD" 

145 PRINT"3-PRINT ACCOUNT SUMMARY" 

150 INPUT"4-QUIT ";A% 

160 ONA%GOSUB1000, 3000, 8000, 250 

170 GOTO110 

250 CLOSE: END 

1000 REM PRINT LOG 

1010 PRINT"*** TURN PRINTER ON ***" 

1015 FL=0:GOSUB2000 

1020 FORSR=0TO23:GOSUB11000 

1030 PR=CVI(LRS) :IFPR=0 THEN GOSUB1250 :GOTO1040 : ELSEGOSUB1400 :GET 1,1 

1040 NEXTSR:LPRINTCHR$(12) :RETURN 

1250 LPRINTTAB(1)SR;":00";TAB(10)"****THIS HOUR HAS NOT BEEN ASSIGNED* ***" :GOSUB 

1300:LPRINT" " :GOSUB1300:RETURN 
1300 PL=PL+1:IFPL<50RETURN 

1310 PL=0:LPRINTCHR$(12) :GOSUB2000 :RETURN 
14 00 FORPX=PRTOPR+5:FORS2=0TO7:GOSUB11200 
1410 GET1,PX:LPRINTTAB(1)SR;":";(PX-PR)*10;TABU0)NM$;TAB(30)AC$;TAB(45)LN$;TAB( 

55)TY$:GOSUB1300 
1420 NEXTS2:LPRINT" " :GOSUB1300 
14 30 NEXTPX:LPRINT" " :G0SUB1 300; RETURN 
2000 GOSUB11100:GET1,1:LPRINT"RADIO LOG FOR STATION: " ;RS 5 :LPRI NT "LOG FOR 24 HOUR 

PERIOD: ";DATE$ 
2010 LPRINTTAB(l) "TIME" ;TAB ( 10 ) "SPONSOR" ;TAB (30) "ACCOUNT" , -TAB ( 45) "SPOT" ; TAB ( 55 ) " 

TYPE":LPRINT" ":RETURN 
3000 REM SCHEDULE TIME SLOT 
3010 GOSUB11100:GET1,1:PRINT"RADIO LOG FOR: " ;RS$ , "DATE OF :" ,-DATES : PRINT: CR=CVI (C 

R$) :HMS="" 
3020 LINEINPUT"ENTER TIME TO SCHEDULE (HH : MM) :"; HMS 
3030 IFLEFTS(HMS,1)="Q" OR HMS="" RETURN 

3040 GOSUB10000:SR=HR:IFSR<0ORSR>23PRINT"NOT A VALID HOUR****" :GOTO3020 
3050 GOSUB11000:GET1,1:MR=CVI(LR$) : IFMRO0 :GOTO3100 
3060 PRINT"NOTHING IS SCHEDULED FOR THAT HOUR****" 

3070 MR=CR+1:LSETLR$=MKI$(CR+1) :GOSUB11100 :LSETCRS=MKI$ (CR+6) : PUT1 , 1 :CR=CR+6 
3080 FORPQ=MRTOMR+5:FORS2=0TO7:GOSUB11200:LSETNM$="**TIME NOT SPRD" :LSETACS=" 

":LSETLN$=" ":LSETTY$=" " :NEXTS2 : PUT1 ,PQ :NEXTPQ 
3100 MX=MR+INT(MN/10) :S2=0 :GOSUB11200 :GET1 ,MX 
3120 PRINT:PRINTTAB(1)HM$;TAB(10)NMS;TAB(30)AC?;TAB(45)LNS;" SEC SPOT" ; TAB ( 58) "T 

YPE=";TYS: PRINT :YS="Q" 
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3130 INPUT"DO YOU WANT TO CHANGE THIS ONE?";YS 

3140 IFYS="N" THEN S2=S2+1: IFS2=8 THEN GOTO3020 : ELSEGOSUB11200:GOTO3120 

3145 IFYS="Q"GOTO3020 

3150 IFY$<>"Y" THEN GOTO3130 :ELSEPRINT"ENTER FIELD SPECIFIED OR * FOR NO CHANGE 

OR -Q- TO QUIT":AAS="" 
3160 LINEINPUT"ENTER NAME OF SPONSOR: " ;AAS : IFLEFTS (AAS , 1) ="*"GOTO3190 
3170 IF AAS="" GOTO 3400 
3180 LSETNM$=AA$ 

3190 INPUT-ENTER ACCOUNT NUMBER (OR * OR Q) : " ; AA$ : IFLEFTS (AAS , 1) ="*"GOTO3230 
3200 IFLEFTS (AAS, 1) ="Q"GOTO3400 
3210 LSETACS=AAS 
3230 INPUT"£NTER SPOT LENGTH IN SECONDS (OR » OR -q-) :"; AAS : IFLEFTS (AAS , 1) ="*"GO 

TO326 
3240 IFLEFTS (AAS, 1 ) ="Q"GOTO3400 
3250 LSETLNS=AAS 
3260 INPUT"ENTER SPOT TYPE-1 CHARACTER (OR * OR -Q-) :"; AAS : IFLEFTS (AAS, 1) ="*"GOT 

03400 
3270 IFLEFTS(AAS,1)="Q"GOTO3400 
3280 LSETTYS=AAS 

3400 PUT1,MX:S2=S2+1:IFS2=8 THEN GOTO3020:ELSEGOSUB11200:GOTO3120 
8000 REM SORT AND PRINT ACCOUNT SUMMARIES BY 30/60 SEC SPOTS 
8010 LR=1 

8020 F0RPZ=2T0L0F(1) :FORS2=0TO7 

8030 GOSUB11200:GET1,PZ:IFACS=" "GOTO8200 

8040 GOSUB8400:IFLNS="30"THENS3(I)=S3(I)+1:GOTO8200 
8050 IFLNS="60"THENS6(I)=S6(I)+1:GOTO8200 
8200 NEXTS2:NEXTPZ 

8210 LPRINT"**** ACCOUNT SUMMARY ****" :LPRINT" " 

8220 GOSUB11100:GET1,1:LPRINT"FOR:";RSS,"FOR DATE: " ;DATES : LPRINT" ":LPRINT" " 
8230 F0RI=1T0LR-1: 
8235 GOSUB 15000 

8240 LPRINT"ACC0UNT8:";ATS,S3(I);" 30 SECOND SPOTS" , S6 ( I ) ; " 60 SECOND SPOTS" 
8250 NEXT I 

8260 LPRINTCHRSU2) : RETURN 
8400 IFLR=1GOTO8430 

8410 F0RI=1T0LR-1: GOSUB 15 000: IFACS=MIDS (AT$, 1 , LEN (ACS) ) GOT085 00 
8420 NEXTI 
8430 LR=LR+1: I=LR-1 

8435 FOR J=l TO 10: AZS (I , J) =MIDS (ACS, J,l) :NEXT J: S3 ( I) =0 : S6 ( I) =0 
85 00 RETURN 

10000 REM CONVERT HM$HH:MM TO HR,MN INDEXES 
10010 IFMIDS(HMS,2,1)=C0S THEN HR=VAL (LEFTS (HMS , 1 ) ) : 1=3 : ELSEHR=VAL (LEFTS (HMS, 2) ) 

:I = 4 
10020 IFMIDS(HM$,I+1,1)=>"0"ANDMIDS(HMS,I+2,1)<="9" THEN MN=VAL(MIDS (HMS, I, 2) ) : E 

LSEMN=VAL(MIDS(HMS,I,1) ) 
10025 PRINT HR,MN 
10030 RETURN 

11000 FIELD 1,SR*2ASDMS,2ASLRS:RETURN 

11100 FIELD 1,220ASDMS,20ASRSS,8ASDATES,2ASJDS,2AS CRS, 3ASDXS: RETURN 
11200 FIELD 1,S2*31ASDMS,15ASNMS,10ASACS,2ASLNS,1ASTYS,3ASRRS:RETURN 
15000 ATS=" ":FOR J=l TO 10 : MIDS (ATS, J, 1) =AZ$ (I , J) :NEXT J:RETURN 
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POWER SUPPLY DESIGN : by Brian and Dale Matheny 



The most fundamental of all 
ham construction projects is now 
made easy with our power supply 
program. All you need to know 
are your output voltage and cur- 
rent requirements, as well as per- 
cent maximum tolerable ripple. 
The program calculates all com- 
ponent values and even draws the 
finished schematic (in full wave 
bridge configuration), labeling 
the parts in the process. Worth its 
weight in zeners. 
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REM: INPUT ROUTINE 
CLEAR100 
CLS 

AA$="POWER SUPPLY" 

CLS: PRINT: PRINT" THE RANGE OP OUTPUT VOLTAGES IS PROM -5000 V TO +5000 V" 
T1=117:DIMG(28) ,E(24) 

PRINT" THE RANGE OP OUTPUT CURRENTS IS FROM 10MA (.01 A) TO 20 AMPS" 
PRINT" THE DESIRED MAXIMUM AMOUNT OF AC RIPPLE ON THE OUTPUT CAN BE FROM 

.01% TO 50%" 
PRINT" THE AC LINE REGULATION CAN BE FROM .01% TO 10%" 

PRINT:PRINT"NOTE: FOR POSITIVE SUPPLIES GROUND THE NEGATIVE OUTPUT TERMINAL. 
FOR NEGATIVE VOLTAGE SUPPLIES GROUND THE POSITIVE TERMINAL. FOR DUAL VOLTA 

GE SUPPLIES IT IS NECESSARY TO BUILD TWO SUPPLIES AND TIE THE TWO GROUND PO 

INTS TOGETHER." 
PRINT 

INPUT"WHAT VOLTAGE IS DESIRED FOR THE OUTPUT" ;V 
VZ=V 
IFV<-5000ORV>5000ORV>-1ANDV<1THENPRINTCHR$(27) ;:PRINT" " :PRINTCHRS (27 ) ;:GOTO 

200 
PRINT"WHAT IS THE DESIRED OUTPUT CURRENT (IN AMPS)"; 
INPUTC 

IFC< . 01ORO20PRINTCHR$ ( 27 ) : : GOTO220 

SM=1:H8=V:V1=V:V=ABS(V):GOSUB1370:SM=0:V=H8:R1=1:R2=2:IFRE>0THBN300 
INPUT"WHAT IS THE MAXIMUM DESIRED OUTPUT RIPPLE" ;R1 
IFRK . 01ORR1>50PRINTCHR$ (27 ) ; : GOTO250 
INPUT"WHAT LINE REGULATION" ;R2 
IFR2 < . 01ORR2>10PRINTCHRS ( 27 ) ; : GOT027 
REM 

REM: CHECK ROUTINE TO DETERMINE WHICH SECTION TO SELECT 
IFV>=-200ANDV<=200THEN320 
GOTO370 

IFO=2ANDC< = 20THEN340 
GOTO370 

IFR1 >= . 1ANDRK=50THEN360 
GOTO370 

IFR2>=.1ANDR2<=10THEN530 
IFV>=-200ANDV<=200THEN390 
GOTO410 

IFO=.01ANDC<=4THEN1260 

IFV>=-5000ANDV<-200ORV>200ANDV<=5000THEN430 
GOTO480 

IFO=.01ANDC< = 2THEN450 
GOTO4 80 

IFR1>=-1ANDRK=50THEN470 
GOTO480 

IFR2>=.1ANDR2<=10THEN2140 

PRINT"YOUR SPECIFICATIONS ARE NOT POSSIBLE UNDER STANDARD DESIGNS" 
FORI=1TO1000:NEXTI:RUN140 
REM: LOW VOLTAGE, HIGH CURRENT 

CLS:PRINT"THIS IS THE LOW VOLTAGE HIGH CURRENT DESIGN SECTION" 
PRINT:PRINT"CIRCUITS IN THIS SECTION HAVE THE FOLLOWING PARAMETERS:" 
PRINT" 1. VOLTAGES FROM -200V TO +200V" 
PRINT" 2. CURRENT VALUES BETWEEN 2 AND 20 AMPS" 
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570 PRINT" 3. LOAD REGULATIONS PROM .1* TO 50% OF RIPPLE" 

580 PRINT" 4. LINE REGULATIONS FROM .1% TO 10% OF VARIANCE" 

590 V1=V:V=ABS(V) 

600 IFV*C<1700PRINT:PRINT"THE WATAGE IS"V*C"WHICH MAY BE TOO"; :GOTO630 

610 IFV*O=1700PRINT:PRINT"THE WATTAGE IS"V*C"WHICH IS TOO"; :GOTO630 

620 GOTO650 

630 PRINT" MUCH FOR THE STANDARD" : PRINT" 117 VOLT LINE. DO YDO YOU WANT THE 2 

38 VOLT LINE"; 
640 RS=INKEYS:IFR$=""THEN640ELSEIPRS="Y"THENT1=23 8ELSEIFR$="N"THENT1=117ELSE640 
650 T2=V+(.1*V):F=(V*C*1.3)/T1:D1=T2*1.4 
660 C2=C*1.3:C1=D1 

670 IFV>-50ANDV<50THENC3=1000*(C/2)/Rl 
680 IFV<=-50ORV>=50THENC3=800*(C/2)/Rl 
690 IFR2>3THENR3=V*R2 
700 IFR2<=3THENR3=V/.l 
710 REM 

720 PRINT:PRINT"PRESS SPACE TO CONTINUE" 
730 A$=INKEY$:IFA$=""THEN730ELSEIFA$=" "THEN740ELSE730 
7 40 CLS 

750 IFSS=1RETURN 
7 80 GOSUB1040 

790 REM: STRAIGHT LINE GRAPHICS 
800 FORII=15791TO15804:POKEII,140:NEXTII:POKE15805,191:POKE15807,45:FORII=15471T 

015484 :POKEII, 131 :NEXTII :POKE15485 , 143 :POKE15487, 43 :POKE15421, 176 
820 IFAA=1RETURN 
825 REM: PARTS LIST SUBROUTINE 
830 PRINT8512, "PARTS LIST: OUTPUT VOLTAGE: ";VZ; "V";TAB(40) ; "OUTPUT CURRENT:"; 

C;"A" 
840 IFV<5THENC1=5 
8S0 IFC3>1THENC3=INT(C3) 
855 GOSUB4500 

860 PRINT8576,INT(C1) "V0LT,"C3" MFD CAPACITOR"; 
870 DC=C*1.5:IFDC<=1THENDC=1 
880 GOSUB4200 

890 IFDl>1000THENPRINTe640,VD"VOLT«DC"AMP DIODES "NS*16; : GOTO910 

900 PRINT6640,INT(D1)"VOLT"DC"AMP DIODES 4" 

910 PRINT6704,MID$(F$,1,4) ;" AMP FUSE ";: PRINTS736,S; " AMP SWITCH" 

920 IFR3>=1000THEN940 

930 GOTO960 

940 GOSUB4300:P2=INT((V/R3/1000)*V*1. 6*1001/100 :GOSUB4000:PRINT6768, INT (R3*100)/ 

100 "K 0HM"P2"WATT RESISTOR" 
950 GOTO970 
960 GOSUB4400:P2=INT((V/R3)*V*1. 6*10001/1000 :GOSUB4000:PRINT6768, INT (R3*100)/100 

"0HM"P2"WATT RESISTOR"; 
970 IFF<3THENEE=3 
980 IFF>=3THENEE=F 
990 B$=STRS(C2) 
1000 PRINTS832, "TRANSFORMER: " INT (Tl) "VOLT PRIMARY; "INT (T2*10)/10"VOLT SECONDARY 

AT";MID$(B$,1,4);" AMPS" 
1010 IFD1H000GOSUB2430 
1020 IFK=1THENK=0:RETURN 
1030 GOTO3000 
1040 IFDK=50THEND1=50 
1050 FS=STR$(F) 
1060 IFF<3THENEE=3 
1070 IFF>=3THENEE=F 

1080 POKE15362,168:POKE15363,140:POKE15364,148 
1090 POKE15424,131:POKE15425,131:POKE15426,131:POKE15428,181:POKE15429,186:POKE1 

5430, 131:POKE15431, 163 :POKE15432, 187 :POKE15433, 170 :POKE15434 ,170:POKE15435 , 

170:POKE15436,17 9:POKE15437,131:POKE15438,131:POKE15439,131:POKE15440,131:P 

OKE15441 , 131 : POKE15442 ,13 
1 
1100 POKE15443,131:POKE15444,163:POKE15445,187:POKE15446,17 9:POKE15447,131:POKEl 

5448, 131 :POKE15449,131:POKE15450,131:POKE15451, 163 :POKE15452, 187 :POKE15453, 

176:POKE15457,151:POKE15458,131:POKE15459,131:POKE15460,131:POKE15461,131:P 

OKE15462 , 131 : POKE15463 ,17 
1 
1110 POKE1546 4,131: POKE15465 , 131 : POKE15466 , 131 : POKE15467 , 131 : POKE1546 8,131: P0KE1 

5469, 171 :POKE15470, 131 
1120 POKE15495,136:POKE15496,172:POKE15497,170:POKE15498,170:POKE15499,168:POKE1 

5500, 140 :POKE15508, 160 :POKE15509, 190 :POKE15510, 180 :POKE15515, 160 :P0KE15516, 

187:POKE15517,177:POKE15521,149:POKE15527,170:POKE15533,152:POKE15534,129 
1130 POKE15559,162:POKE15560,17 9:POKE15561,170:POKE15562,170:POKE15563,162:POKE1 

5564,17 9:POKE15568,16 8:POKE1556 9,140:POKE15570,140:POKE15571,140:POKE15572, 

140:POKE15573,17 4:POKE15580,170:POKE15581,140:POKE15582,140:POKE15583,140:P 

OKE15584,140:POKE15585,13 
3 
1140 POKE15590,163:POKE15591,17 9:POKE15592,17 9:POKE15593,129:POKE15597,162:POKE1 

5598,132 
1150 POKE15620,144:POKE15623,136:POKE15624,142:POKE15625,170:POKE15626,170:POKE1 

5627,138:POKE15628,140:POKE15632,170:POKE15636,130:POKE15637,175:POKE15638, 

135:POKE15643,130:POKE15644,187:POKE15645,147:POKE15654,129:POKE15655,170:P 

OKE15657 , 129 : POKE15661 ,13 
7 
1160 POKE15662,144:POKE156 80,176:POKE156 81,176:POKE156 82,17 6:POKE156 83,134:POKE1 

5685,160:POKE156 86,176:POKE15687,17 8:POKE156 88,187:POKE156 89,17 0:POKE156 90, 
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170:POKE15691,170:POKE15692,17 9:POKE15693,176:POKE156 94,176:POKE15695,176:P 

OKE15696,186:POKE15697,17 
6 
1170 POKE15698,176:POKE15699,176:POKE15700,17 8:POKE15701,187:POKE15702,1?9:FOKE1 

5703,176:POKE15704,176:POKE15705,176:POKE15706,176:POKE15707,17 8:P° KE1 5708, 

187:POKE15709,131:POKE15719,170:POKE15725,166 
1180 FORII=15761TO157 90:POKEII,140:NEXTII:POKE15760,138:POKE157 83,142:P° KE 157 89, 

142 
1190 W$=STRS(T2) 

1195 IFF<3THENEE=3 

1196 IFF>=3THENEE=F 
1198 S=EE:GOSUB4600 

1200 PRINT8192,INT(Tl*10+.5)/10;"V"i:PRINT@386,S;"A";:EB=S 
1210 FU=VAL(FS):GOSUB4100:F$=STR$(FU):PRINTe5,MID?{F$,l,4);"A"; 
1220 IFT2<3THENPRINT§141,MID$(W$,2,6);"V";ELSEPRINTei41,INT(T2);"V": 
1240 RETURN 

1250 GOTO3000 

1255 REM: MEDIUM VOLTAGE, LOW CURRENT 

1260 CLS:PRINT"THIS IS THE MEDIUM VOLTAGE LOW CURRENT DESIGN "SECTION" 

1280 PRINT:PRINT"THE PARAMETERS FOR CIRCUITS IN THIS SECTION ARE:" 

1285 PRINT" 1. VOLTAGES CAN BE FROM -200V TO +200V" 

1290 PRINT" 2. CURRENTS BETWEEN 10MA (.01A) AND 2 AMPS" 

1300 PRINT" 3. LOAD REGULATIONS FROM .01% TO 50S OF RIPPLE" 

1310 PRINT" 4. LINE REGULATIONS FROM .01% TO 10% OF VARIANCE" 

1320 PRINT: PRINT"¥OUR CIRCUIT USES'ABS(V) *C"WATTS OF POWER" 

1330 PRINT'DO YOU WANT 238 VOLT LINE" 

1340 S$=INKEY$:IFS$=""THEN1340ELSEIFS$="Y"THENT1=238ELSEIFSS="N"THENT1=H7ELSE13 
40 

1350 CLS 

1360 V1=V:V=ABS(V) 

1370 IFO1THEN1450 

1380 IFV>4.6ANDV<5.4THENV=5:RE=5 

1390 IFV>5.6ANDV<6.4THENV=6:RE=6 

1400 IFV>7.6ANDV<8.4THENV=8:RE=8 

1410 IFV>11.6ANDV<12.4THENV=12:RE=12 

1420 IFV>14.6ANDV<15.4THENV=15:RE=15 

1430 IFV>17.4ANDV<18.6THENV=18:RE=18 

1440 IFV>23.4ANDV<24.6THENV=24:RE=24 

1450 IFSM=1RETURN 

1455 T2=V+(.2*V) 

1460 F=(V*C*1.2)/T1 

1470 D1=T2*1.3 

1480 C2=C*1.3:C1=D1 

1490 IFR1>=.1THENC3=4000/R1 

1500 IFRK.1THENC3=2000/R1 

1510 IFR2>3THENR3=V*R2:GOTO1530 

1520 IFR2<=3THENR3=V/.l 

1530 REM 

1540 PZ=V*C*1.25:IZ=(PZ/V)*.9:R4=(C1-V)/C:P3=((C1-V)*C)*1.5 

1550 IFRE=5ANDVK0THENRG=7905 

1560 IFRE=5ANDV1>0THENRG=7805 

1570 IFRE=6ANDVK0THENRG=7 906 

1580 IFRE=6ANDV1>0THENRG=7806 

1590 IFRE=8ANDVK0THENRG=7908 

1600 IFRE=8ANDV1>0THENRG=7808 

1610 IFRE=12ANDVK0THENRG=7912 

1620 IFRE=12ANDV1>0THENRG=7 812 

1630 IFRE=15ANDVK0THENRG=7915 

1640 IFRE=15ANDV1>0THENRG=7815 

1650 IFRE=18ANDVK0THENRG=7918 
1660 IFRE=18ANDV1>0THENRG=7818 
1670 IFRE=24ANDVK0THENRG=7924 
1680 IFRE=24ANDV1>0THENRG=7824 
1690 IFRE>0THENC3=50000:R3=1000 
1720 IFRE>0THENV1=V 
1730 GOSUB1040 
17 40 IFRE>0THEN2000 

1750 IFR4>1000THENR4=R4/1000:J5="K" 
1760 M=R3:R3=R4:GOSUB4400 
1765 PRINTS54,INT(R3*100)/100;J$;:R3=M 

1770 REM FROM HERE TO 1850 IS THE GRAPHICS FOR THE ZENER DIODE 
17 80 POKE15409,144:POKE15411,144:POKE15413,144:POKE15420,176 

1790 POKE15471,131:POKE15472,131:POKE15473,130:POKE15474,134:POKE15475 ,130:POKE1 
5476,134:POKE15477,130:POKE1547 8,131:POKE1547 9,131:POKE15480,131:S'OKE15481, 
171:POKE15482,131:POKE15483,131:POKE15484,143:POKE15486,43 
1800 POKE15544,160:POKE15545,186:POKE15546,176:POKE15547,132:POKE15548 , 129 
1810 POKE15607,132:POKE15608,161:POKE15609,174:POKE15610,164 
1820 POKE15673,170 ' 

1830 POKE15737,170 
1840 FORII=15791TO15803:POKEII,140:NEXTII:POKE15804,191:POKE15801,142:S'O'<E15806, 

45 
1870 K=l 

1880 IFRE>0THENC3=3300 
1900 GOSUB830 
1910 IFRE>0THEN1970 
1915 A=P2 : P2=P3:GOSUB4000 : P3=P2 : P2=A 
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1920 M=R4:R3=R4:N=P3:P2=P3 

1930 GOSUB4400:GOSUB4000:PRINT8800,INT(R3*100)/100"OHM"P2"WATT RESISTOR"; 

1935 P3=N:R4=M 

1940 M$=STR$(V) :PZS=STR$(PZ) 

1950 PRINT8672,MID$(M$,1,4);" VOLT, ";HID$(PZ$, 1,5) ; " WATT ZENER"; 

I960 GOTO3000 

1970 PRINT" A";RG"VOLTAGE REGULATOR" 

1980 IPVK0PRINT"PUT THE VOLTAGE REGULATOR IN THE NEGATIVE LINE" 

1990 GOTO3000 

2000 FORI I=15791TO15803 :POKEII, 140 :NEXTII:POKE15804, 191 :POKE15806, 45 :POKE157 98,1 

41 
2010 POKE157 34,149:POKE15670,149:POKE15606,149:POKE15542,151:POKE1553 9,131:POKE1 

5540, 131 :POKE15541, 131 :POKE15543, 131 :POKE15544, 131 :POKE15471, 131 :POKE15472, 

131:POKE15473,131:POKE15474,131:POKE15475,149:POKE15480,170:POKE15481,131:P 

OKE15482,131 
2015 POKE15483,131 
2020 POKE15484,143:POKE15420,176:POKE15486,43:POKE15411,156:POKE15412,140:POKE15 

413,140:POKE15414,140:POKE15415,140:POKE15416,172 
2030 FORII=2T05:POKE15474+II,ASC(MID$(STR$(RG),II,l)) rNEXTII 
2120 GOTO1870 
2130 GOTO3000 

2135 REM: HIGH VOLTAGE, LOW CURRENT 

2140 CLS:PRINT"THIS IS THE HIGH VOLTAGE LOW CURRENT POWER SUPPLY DESIGN SECTION" 
2160 PRINT:PRINT"CIRCUITS IN THIS SECTION HAVE THE FOLLOWING PARAMETERS:" 
2170 PRINT" 1. VOLTAGES BETWEEN -5000V TO -200V AND + 200V TO +5000V" 
2175 PRINT" 2. CURRENTS BETWEEN 10MA (.01A) AND 2 AMPS" 
2180 PRINT" 3. LOAD REGULATIONS FROM .1% TO 50S OF RIPPLE" 
2190 PRINT" 4. LINE REGULATIONS FROM .1% TO 10» OF VARIANCE" 
2200 SS=1 
2210 V1=V:V=ABS(V) 
2220 PRINT 

2230 PRINT"YOUR CIRCUT USES"V*C"WATTS" 

2240 PRINT"DO YOU WANT TO USE 238 VOLT PRIMARY LINE"; 
2250 GOSUB640 
2260 IFV<=500THEN2262ELSE2264 

2262 C3=C*V/(R1*5) 

2263 GOTO2270 

2264 C3=C*V/(R1*10) 

2270 IFR2>3THENR3=V*R2*20 

2280 IFR2<=3THENR3=(V/.1)*20 

2290 K=l 

2300 PRINT:PRINT 

2310 GOSUB1040 

2320 AA=1 

2330 REM 

2340 GOSUB800 

2350 IFD1>1000THENGOSUB2400 

2360 GOSUB830 

2370 GOTO3000 

2400 IFD1>1000ANDDK4000THENVD=1000:NS=1 

2410 IFD1>=4000ANDD1<8000THENVD=1000:NS=2 

2420 RETURN 

2430 PRINTS960, "PRESS SPACE FOR DIODE STRING DISPLAY"; 

2440 T$=INKEY$:IFT$=""THEN2440ELSEIFT$=" "THEN2450ELSE2440 

2445 REM: DIODE STRING ARRANGMENT 

2450 CLS:PRINT"YOUR VOLTAGE IS TOO MUCH FOR SINGLE DIODES IN THE BRIDGE CIRCUT. 

SO IT IS RECOMMENDED THAT YOU USE THE FOLLOWING DIODE ARRANGEMENT. 
2480 PRINT 
2490 PRINT"THE RESISTORS AND CAPACITORS ARE TO INSURE EVEN CURRENT AND VOLTAGE D 

ISTRIBUTION AMONG THE INDIVIDUAL RECTIFIERS." 
2510 PRINT:PRINT"PRESS SPACE TO CONTINUE" 
2520 Z$=INKEYS:IFZ$=""THEN2520 
2540 CLS 
2550 PRINT69,".01 UF";TAB(21) ; ".01 UP" ;TAB(32) ; ".01 UF" ;TAB(44) ; ".01 UF" 

2560 POKE15431,168:POKE15432,140:POKE15433,140:POKE15434,174:POKE15436,170:POKE1 
5437, 140 :POKE15438, 140 :POKE15439, 172 :POKE15443, 156 :POKE15444, 140 :POKE15445, 
140:POKE15446,149:POKE15448,157:POKE15449,140:POKE15450,140:POKE15451,148:P 
OKE15454,168 

2561 POKE15455,140 

2562 POKE15456,140:POKE15457,174:POKE15459,170:POKE15460,140:POKE15461,140:POKE1 
5462,172:POKE15466,156:POKE15467,14 0:POKE15468,14 0:POKE15469,149:POKE15471, 
157:POKE15472,140:POKE15473,140:POKE15474,148:POKE15495,170:POKE15499,144:P 
OKE15500,160 

2563 POKE15503,170 

256 4 POKE15507 , 14 9 : POKE15510 , 160 : POKE15512 , 144 : POKE15515 , 149 :POKE15518 , 170 :P0KE1 
5522, 144 :POKE15523, 160 :POKE15526, 170 :POKE15530, 149 :POKE15533, 160 :POKE15535, 
144:POKE1553 8,149:POKE15556,191:POKE15557,140:POKE15558,140:POKE15559,174:P 
OKE15560,140 

2565 POKE15561.140 

2566 POKE15562,140:POKE15563,157:POKE15564,191:POKE15565,140:POKE15566,140:POKE1 
5567,17 4:POKE1556 8,140:POKE15569,140:POKE15570,140:POKE15571,157:POKE1557 2, 
140:POKE15573,140:POKE15574,17 4:POKB15575,174:POKE15576,157:POKE15577,140:P 
OKE15578,140 

2567 POKE15579,157 

256 8 POKE15580,14 0:POKE15 581,140:POKE15582,17 4:POKE1558 3,140:POKE15584,14 0:POKE1 
5585, 140 :POKE15586, 157 :POKE15587, 191 :POKE15588, 140 :POKE15589, 140 :POKE15590, 



142 



174:POKE15591,140:POKE15592,140:POKE15593,140:POKE15594,157:POKE15595,140:P 
OKE15596,140 

2569 POKE15597,174 

2570 POKE15598,17 4:POKE15599,157:POKE15600,140:POKE15601,140:POKE15602,157:POKE1 
5603, 140 :POKE15604, 140 :POKE15605, 191 :POKE15623, 170 :POKE15627, 129 :POKE1562B, 
130:POKE15631,170:POKE15635,14 9:POKE15638,130:POKE15640,129:POKE15643,149:P 
OKE15646,170 

2571 POKE15650.129 

2572 POKE15651,130:POKE15654,170:POKE15658,149:POKE15661,130:POKE15663,129:POKE1 
56 66,149:POKE15687,138:POKE15688,140:POKE15689,137:POKE15690,152:POKE15691, 
137:POKE15692,152:POKE15693,137:POKE156 94,140:POKE15695,142:POKE156 99,141:P 
OKE15700,134 

2573 POKE15701.164 

2574 POKE15702,134:POKE15703,164:POKE15704,134:POKE15705,140:POKE15706,140:POKE1 
5707, 133 :POKE15710,138:POKE15711, 140 :POKE15712, 137 :POKE15713,152:POKE15714, 
137:POKE15715,152:POKE15716,137:POKE15717,140:POKE15718,142:POKE15722,141:P 
OKE15723,134 

2575 POKE15724.164 

2576 POKE15725,134:POKE15726,164:POKE15727,134:POKE15728,140:POKE15729,140:POKE1 
5730,133 

2610 PRINT8393,"100 K",-TAB(21) ; "100 K";TAB(32) ; "100 K" ;TAB(44) ; "100 K" 

2630 IFNS=1PRINT:PRINT"USE THE ABOVE STRING IN PLACE OF EACH DIODE IN THE SCHEMA 

TIC"ELSEIFNS=2PRINT"USE TWO OF THESE STRINGS IN PLACE OF EACH DIODE IN THE 

SCHEMATIC" 
2650 PRINT"DO YOU WANT TO SEE THE SCHEMATIC AGAIN" 
2660 F$=INKEY$:IFFS=""THEN2660 
2665 IFFS="Y"CLS:GOSUB1040:GOTO2680 
2667 IFFS="N"THEN3005ELSE2660 
2670 RETURN 
2680 AA=1 
2690 REM 
2700 GOSUB800 
2710 RETURN 

3000 REM: ENDING ROUTINE 

3005 PRINT6960,"DO YOU WANT TO DESIGN ANOTHER POWER SUPPLY"; 
3010 QS=INKEY5:IFQS="THEN3010 
3020 IFQ$="Y"THENCLEAR:GOTO140 
3025 IFQ$O"N"THEN3010 

3030 PRINT:PRINT"EXECUTION TERMINATED" :END 
3990 REM: RESISTOR STANDARD WATTAGE VALUE SELECTION 
4000 IFP2<=.125THENP2=.125ELSEIFP2<=.25ANDP2>.125THENP2=.25ELSEIFP2<=1ANDP2>.25T 

HENP2=1ELSEIFP2<=2ANDP2>1THENP2=2ELSEIFP2<=5ANDP2>2THENP2=5BLSEIFP2<=10ANDP 

2>5THENP2=10ELSEIFP2<=25ANDP2>10THENP2=25ELSEIFP2<=50ANDP2>25THENP2=50 
4010 IFP2<=75ANDP2>50THENP2=75ELSEIFP2<=100ANDP2>75THENP2=100ELSEIFP2<=125ANDP2> 

100THENP2=125ELSEIFP2<=150ANDP2>125THENP2=150 
4020 RETURN 

4095 REM: FUSE STANDARD VALUE SELECTION 
4100 IFFU<=.03125THENFU=.03125BLSEIFFU<=.0625ANDFU>.03125THENFU=.0625ELSEIFFU<=. 

125ANDFU>.0625THENFU=.125ELSEIFFU<=.25ANDFU>.125THENFU=.25ELSEIFFU<=.5ANDFU 

>.25THENFU=.5ELSEIFFU<=.75ANDFU>.5THENFU=.75ELSEIFFU<=1ANDFU>.75THENFU=1.5 
4110 IFFU<=2ANDFU>1.5THENFU=2ELSEIFFU<=3ANDFU>2THENFU=3ELSEIFFU<=4ANDFU>3THENFU= 

4ELSEIFFU<=5ANDFU>4THENFU=5ELSEIFFU<=7ANDFU>5THENFU=7ELSEIFFU<=10ANDFU>7THE 

NFU=10ELSEIFFU<=15ANDFU>10THENFU=15ELSEIFFU<=20ANDFU>15THENFUs.20ELSEIFFU<=3 

0ANDFU>20THENFU=30 
4120 IFFU<=40ANDFU>30THENFU=30ELSEIFFU<=50ANDFU>30THENFU=50ELSEIFFU<=60ANDFU>50T 

HENFU=60ELSEIFFU<=80ANDFU>60THENFU=80ELSEIFFU<=100ANDFU>80THENFU=100 
4130 RETURN 

4190 REM: DIODE STANDARD VOLTAGE SELECTION 
4200 IFDK = 50THEND1=50ELSEIFDK=100ANDD1>50THEND1=100ELSEIFDK = 200ANDD1>100THEND 

1 = 200ELSEIFDK=40 0ANDD1<200THEND1=400ELSEIFDK = 600ANDD1<400THEND1=60 0ELSEIF 

DK = 800ANDDK600THEND1=800ELSEIFDK = 1000ANDD1<800THEND1 = 1000 
4205 IFDC<=1THENDC=1ELSEIFDC<=2ANDDC>1THENDC=2ELSEIFDC<=3ANDDC>2THENDC=3ELSEIFDC 

<=4ANDDC>3THENDC=4ELSEIFDC<=5ANDDC>4THENDC=5ELSEIFDC<=6ANDDC>5THENDC=6ELSEI 

FDC<=8ANDDO6THENDC=8ELSEIFDC< = 10ANDDC>8THENDDC=10ELSEIFDC<=20ANDDO10THEND 

C=20 
4207 IFDC< = 30ANDDO20THENDC=30 
4210 RETURN 

4290 REM: OVER IK RESISTOR STANDARD RESISTANCE VALUE SELECTION 
4300 R3=R3/1000:FORL=1TO28:READG(L) : NEXTL :F0RL=1T026 :IFR3<1.3*G{L) ANDR3>. 8*G(L)T 

HENR3=G(L) :GOTO4307 
4305 NEXTL 
4307 RETURN 
4310 DATA. 68, 1,1. 2, 1.5, 1.8, 2. 2, 3. 3, 4. 7, 5. 6, 6. 8, 8. 2, 10, 12, 15, 22, 27, 33, 39, 47, 56, 10 

0,120,150,220,27 0,470,1000,2200 
4390 REM: UNDER IK RESISTOR STANDARD RESISTANCE VALUE SELECTION 
4400 E(1)=10:E(2)=15:E(3)=22:E(4)=27:E(5)=33:E(6)=47:E(7)=68:E(8)=82:E(9)=100:E( 

10)=150:E(11)=180:E(12)=220:EU3)=270:EU4)=330:E(15)=390:E(16)=470:E(17)=5 

60:E(18)=680:E(19)=.56:E(20)=1:E(21)=3.3:E(22)=.1:S{23)=.33:E(24)=.47 
4410 F0RL=1T024:IFR3<=1.2*E(L)ANDR3>=.8*E(L)THENR3=E(L) :GOTO4430 
4420 NEXTL 
443 RETURN 

4490 REM: CAPACITOR STANDARD VOLTAGFE SELECTION 
4500 IFC1<=6THENC1=6ELSEIFCK=10ANDC1>6THENC1=10ELSEIFCK = 12ANDC1>10THENC1=12ELS 

EIFC1<=15ANDC1>12THENC1=15ELSEIFC1<=20ANDC1>15THENC1=20ELSBIFCK=25ANDC1>15 

THENC1=25ELSEIFCK=30ANDC1>25THENC1=30ELSEIFCK=35ANDC1>25ELSEIFCK=50ANDC1 

>35THENC1=50ELSEIFC1< 



143 



4510 IFC1<=45ANDC1>35THENC1=45ELSEIFCK=63ANDC1>S0THENC1=63ELSEIFCK=100ANDC1>75 

THENC1=100ELSEIFCK=150ANDC1>100THENC1=150ELSEIFCK=200ANDC1>150THENC1=200E 

LSEIFCK=300ANDC1>200THENC1=300ELSEIFCK=350ANDC1>300THENC1=350ELSEIFC1<=45 

0ANDC1>350THENC1=450 
4515 IFCK=600ANDC1>450THENC1=600ELSEIFCK=800ANDC1>600THENC1=800ELSEIFCK=1000A 

NDC1>800THENC1=1000ELSEIFCK=1500ANDC1>1000THENC1=1500ELSEIFCK=2000ANDC1>1 

500ELSEIFCK=3000ANDC1>2000THENC1=3000 
4520 RETURN 

4590 REM: STANDARD SWITCH VALUE SELECTION SUBROUTINE 
4600 IFS<=5ANDS>3THENS=5ELSEIFS<=7ANDS>5THENS=7ELSEIFS<=10ANDS>7THENS=10ELSEIFS< 

=15ANDS>10THENS=15ELSEIFS<=20ANDS>15THENS=20ELSEIFS<=30ANDS>20THENS=30ELSEI 

FS<=50ANDS>30THENS=50 
4610 RETURN 



INTRODUCTION TO DIGITAL LOGIC: by Dave Fornshil 



This well-done program is a 
self-teaching course designed to 
introduce the basics of TTL logic 
to the neophyte. Excellent text 
and graphics depict all types of 
gates with user selected input 
conditions. Gates will actually 
change state according to key- 
board commands, allowing the 
student to visually follow the ac- 
tion. An excellent primer for fur- 
ther studies of microprocessors 
and minicomputers. 




20 CLS: PRINT624," INTRODUCTION 

30 PRINT887 , "* *" 

40 PRINT8198,"THE INTENT OF THIS SELF-TAUGHT COURSE IS TO TEACHAS FAST AND EFF 

ECTIVELY AS POSSIBLE THE FUNDAMENTALS OF DIGITAL LOGICS. 
50 PRINT9390,"WITH THE AID OF 'LIVE' VISUAL DIAGRAMS THAT CHANGE CONDITIONS OR 

'STATES' ON VARIOUS TYPES OF GATES ONECAN BETTER UNDERSTAND AND RETAIN THE 

MATERIAL." 
60 PRINTS582,"ALL TYPES OF GATES WILL BE COVERED AND GRAPHICALLY SHOWN, WITH AL 

L POSSIBLE INPUT AND OUTPUT CONDITIONS DISPLAYED." 
70 PRINT8774, "AFTER EACH GATE HAS BEEN EXPLAINED, A VISUAL DIAGRAM WILL BE D 

ISPLAYED WHICH WILL ALLOW YOU TO CHOSE YOUR OWN INPUT CONDITIONS TO STUDY 
THE FUNCTION OF THE " 
80 PRINT@966,"GATE."; 

90 PRINT6995,"TAP 'ENTER' TO CONTINUE"; 
100 A$=INKEY$: IF A$="" THEN 100 
110 CLS:PRINT@070,"THE LAST PORTION OF THE COURSE WILL COVER TROUBLESHOOTING 

,TOO MANY COURSES TEACH EXCELLENT THEORY BUT FALL SHORT IN THE AREA OF" 
120 PRINT8262, "APPLYING IT TO TROUBLESHOOTING. GENERAL TROUBLESHOOTING TECHNIQUE 

S WHICH APPLY TO ALL ELECTRONICS WILL BE DISCUSSEDD FIRST, THEN WHAT APP 

LIES ONLY TO DIGITAL " 
130 PRINTS454, "LOGIC WILL BE COVERED. THE CORSE THEN CLOSES WITH TWO IDENTICAL C 

IRCUITS IN WHICH YOU MAY INSERT DIFFERENT INPUTS AND COMPARE" 
140 PRINT6646, "OUTPUTS."; 

150 PRINT8995,"TAP 'ENTER' TO CONTINUE"; 
160 A$=INK£YS: IF A$="" THEN 160 
170 CLS: PRINTO015, "GENERAL DIGITIAL LOGIC INFORMATION" 

180 PRINTS077 , "* *" 

190 PRINTei34,"IN THIS COURSE, WE WILL BE WORKING WITH THE MOSTCOMMONLY ACCEPTED 
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TYPE OF LOGIC WHICH IS 'POSTIVE' LOGIC. THERE ARE ALSO 'NEGATIVE' LOGIC SY 
STEMS, BUT" 

200 PRINT8326,"ONLY ROUGHLY 20% OF THIS TYPE. 'POSTIVE' LOGIC MEANSA '1' PULSE I 
S GOING IN THE POSTIVE VOLTAGE DIRECTION , WITH RESPECT TO ELECTRONIC GROU 
ND. USUALLY A POS-" 

210 PRINT@518,"ITIVE 5 VOLTS IS CONSIDERED A '1' PULSE. mOST IC ' S (INTEGRATED C 
IRCUITS) OR 'CHIPS' ARE DESIGNED TO RECOGNIZE A 3 VOLT PULSE OR BETTER AS A 
'1' PULSE." 

220 PRINT8710,"A '0' PULSE IS DEFINED AS, NOT DIRECT ELECTRONIC GROUND, BUT AN A 
BSENCE OF VOLTAGE. THEREFORE AN OPEN OR UNCONNECTED INPUT TO A GATE WOULD 
BE SEEN AS A '1' 

230 PRINT8902, "INPUT"; 

240 PRINT8936,"TAP 'ENTER' TO CONTINUE"; 

250 A$=INKEYS: IF A$="" THEN 250 

260 CLS:PRINT8070,"SO REMEMBER DURING TROUBLESHOOTING AN 'OPEN' WIPRODUCE A '1' 
PULSE TO A GATE. IT SHOULD BE MENTIONED THERE MAY BE SEVERAL 

270 PRINT8262, "INPUTS TO A SINGLE GATE AND MAY BE FOUR INDIVIDUAL GATES WITH FOU 
R OUTPUTS ALL CONTAINED WITHIN ONE ICOR CHIP. FOR SIMPLICITY, THIS COURSE H 
AS WORKED 

280 PRINT8454,"WITH ONLY TWO INPUTS PER GATE. THE LAST ITEM AND NOT TO BE TAKEN L. 
IGHTLY IS THE PROBLEM OF 'STATIC ELECTRICITY' ON 'CHIPS' , ESPECIAL-" 

290 PRINT6646,"LY 'MOS' TYPES. YOU CAN DEFINITELY DESTROY A CHIP BYIMPROPER HAND 
LING. MOST IMPORTANT—KEEP THEM AWAY FROM STATIC MATERIAL, SUCH AS STYROFO 
AM."; 

300 PRINT8936,"TAP 'ENTER' TO CONTINUE"; 

310 A$=INKEYS: IF AS= "" THEN 310 

320 CLS:PRINT:PRINTTAB(25>" NAND GATE " :PRINTTAB(24) "* *"; 

330 PRINT8198, "REMEMBER ONLY ALL 'l'INPUTS WILLPRODUCE A '0' OUTPUT" 

340 GOSUB 40020 

350 GOSUB 30020 

360 PRINT8434,"0 1"; 

370 PRINT8562,"0 1 1"; 

380 PRINT8690,"1 1"; 

390 PRINT8818,"1 1 0"; 

400 PRINT8526,"NAND"; 

410 PRINT8774,"A 1 OR 0"; 

420 INPUT A 

430 PRINT8838,"B 1 OR 0"; 

440 INPUT B 

450 IF A=l THEN 480 

460 PRINT8451,"A=0"; 

470 GOTO 490 

480 PRINT8451,"A=1"; 

490 IF B=l THEN 520 

500 PRINT8579,"B=0"; 

510 GOTO 530 

520 PRINT8579,"B=1"; 

530 IF A+B=2 THEN 570 

540 IF A+B>2 THEN 580 

550 PRINT8537,"C=1"; 

560 GOTO 590 

570 PRINT8537,"C=0"; 

590 PRINT8902,"DO YOU WISH TO TRY SOME OTHER 'NAND' GATE INPUTS?"; 

600 PRINT8966, "PRESS Y FOR YES OR N FOR NO"; 

620 INPUTY$: IFLEFT$(Y$,1)="N" GOTO 650 ELSEIFLEFTS (Y$,l) <> "Y" THEN 620 

630 CLS: GOTO 340 

650 CLS:PRINTTAB(25) " AND GATE " :PRINTTAB(23) "* *": 

660 PRINT8198, "REMEMBER ONLY ALL'l' INPUTS WILL OBTAINA '1' OUTPUT."; 

670 PRINT8528,"AND"; 

680 GOSUB 30020 

690 GOSUB 40020 

700 PRINT8434,"0 

710 PRINT8562,"0 1 

720 PRINT8690,"1 

730 PRINT8818,"1 1 1"; 

740 PRINTe774,"A 1 OR 0"; 

750 INPUT A 

760 PRINT8838,"B 1 OR 0"; 

770 INPUT B 

780 IF A=l THEN 810 

790 PRINT8451,"A=0"; 

800 GOTO 820 

810 PRINT8451,"A=1"; 

820 IF B=l THEN 850 

830 PRINT8579,"B=0"; 

840 GOTO 860 

850 PRINT8579,"B=1"; 

860 IF A+B>1 THEN 890 

870 PRINT8537,"C=0"; 

880 GOTO 900 

890 PRINT8537,"C=1"; 

900 PRINT8902,"DO YOU WISH TO TRY SOME OTHER 'AND' GATE INPUTS?"; 

910 PRINT8966, "PRESS Y FOR YES OR N FOR NO"; 

920 INPUTY$: IFLEFTS(YS,1)="N" GOTO 960 ELSEIFLEFTS (Y$,l) <> "Y" THEN 920 

940 CLS: GOTO670 

960 CLS:PRINTTAB(26)" OR GATE " :PRINTTAB(23) "* *• 

970 PRINT8198," REMEMBER HERE ONLY ALL ' ' INPUTS PRODUCE A '0' OUTPUT." 
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980 GOSUB 30020 

990 GOSUB 40020 

1000 PRINT8434,"0 0°; 

1010 PRINT8562,"0 1 1"; 

1020 PRINT8690,"1 1"; 

1030 PRINT8818,"1 1 1"; 

1040 PRINT8524,"OR GATE"; 

1050 PRINT8774,"A 1 OR 0"; 

1060 INPUT A 

1070 PRINT8838,"B 1 OR 0"; 

1080 INPUT B 

1090 IP A=l THEN 1120 

1100 PRINT8451,"A=0"; 

1110 GOTO 1130 

1120 PRINT8451,"A=1"; 

1130 IF B=l THEN 1160 

1140 PRINT857 9,"B=0"; 

1150 GOTO 1170 

1160 PRINT8579,"B=1"; 

1170 IP A+B>0 THEN 1200 

1180 PRINT8537,"C=0"; 

1190 GOTO 1210 

1200 PRINT8537,"C=1"; 

1210 PRINT8902,"DO YOU WISH TO TRY SOME OTHER 'OR' GATE INPUTS?";" 

1220 PRINT8966, "PRESS Y FOR YES OR N FOR NO"; 

1230 INPUTYS: IFLEFT? (Y$,l) ="N" GOTO 1270 ELSEIFLEFT? (YS,1) <> "Y" THEN 12 

30 
1250 CLS: GOTO 980 

1270 CLS:PRINTTAB(25)" NOR GATE " :PRINTTAB(23) "* * 

1280 PRINT8198,"ALL '0' INPUTS WILL PRODUCE A '1' OUTPUT."; 

1290 PRINT8528,"NOR"; 

1300 PRINT8434,"0 

1310 PRINT8562,"0 1 

1320 PRINT8690,"1 

1330 PRINT8818,"1 1 

1340 GOSUB 30020 

1350 GOSUB 40020 

1360 PRINT8774,"A 1 OR 0"; 

1370 INPUT A 

1380 PRINT@838,"B 1 OR 0"; 

1390 INPUT B 

1400 IF A=l THEN 1430 

1410 PRINT84 51,"A=0"; 

14 20 GOTO 14 50 

1430 PRINT8451,"A=1"; 

1440 IF B=l THEN 1470 

1450 PRINT8579,"B=0"; 

1460 GOTO 1480 

1470 PRINT857 9,"B=1"; 

1480 IF A+B<1 THEN 1510 

1490 PRINT8537,"C=0"; 

1500 GOTO 1520 

1510 PRINT8537,"C=1"; 

1520 PRINT8902,"DO YOU WISH TO TRY SOME OTHER 'NOR' GATE INPUTS?"; 

1530 PRINT8966, "PRESS Y FOR YES OR N FOR NO"; 

1540 INPUTYS: IFLEFTS (YS,1) = "N" GOTO 1580 BLSEIFLEFTS (Y$,l) <> "Y" THEN 15 

40 
1560 CLS: GOTO 1290 
1580 CLS:PRINT@083," SHORT REVIEW & COMMENTS "; 

1590 PRINT8146,"* *"; 

1600 PRINT8198,"HOW ABOUT ALITTLE BREATHER? AT THIS POINT ALL FOUR OF THE BAS 

IC GATES HAVE BEEN COVERED, WHICH WILL NOW BE REVIEWED AND COMPARED.." 
1610 PRINT8390,"THE TRULY ' THOUGHT PROVOKING' THING IS BY INTER CONNECTING THESE 

FOUR SIMPLE GATES, WE ARE ABLE TO DEVELOP SOPHISTICATED SYSTEMS, SUCH AS TH 

E" 
1620 PRINT8582, "SMALL BUT POWERFUL ONE SETTING HERE BEFORE YOU." 
1630 PRINT8646,"WELL, ON WITH THE REVIEW1 REMEMBER HOW ON THE 'NAND' GATE IT TA 

KES ALL 'l'S TO OBTAIN A '0' OUTPUT? ALL YOU NEED TO DO IS REMEMBER THAT FA 

CT AND" 
1640 PRINT8838,"THAT AN 'AND' GATE IS JUST THE OPPOSITE OUTPUT. THE SAME COMPAR 

ISON HOLDS TRUE FOR THE 'NOR' AND 'OR' GATES"; 
1650 PRINT81000,"TAP 'ENTER' TO CONTINUE"; 
1660 A$=INKEY$: IF AS= ""THEN 1660 
1670 CLS :PRINT8019, "TROUBLESHOOTING TECHNIQUES"; 

16 80 PRINT6081 , "* *" 

1690 PRINT8134 , "TROUBLESHOOTING IS FIRST GATHERING ALL POSSIBLE INDICATIONS AND 

FACTS THEN REASONING OUT A LOGICALAPPROACH BEFORE STARTING TO 'PROBE'." 
1700 PRINT8326 , "GENERALLY YOU SHOULD; ASSUME NOTHING, GOOD TEST EQUIPMENT, SPARE 
ELECTRONIC CARDS, OR FACTS RELAT- ING TO THE TROUBLE. START FRESH—ON YOU 

R OWN."; 
1710 PRINT8518, "STICK WITH THE 'ORIGINAL' CARDS AND THEIR POSITIONS DON'T PRODUC 

E ADDED TROUBLES BY 'SWAPPING'. USE YOUR SENSES , LOOK, FEEL, SMELL AND LISTEN. 

1715 PRINT8710, "REMEMBER IF AN INPUT STICKS AT ' 1 ' AND YOU ARE INPUTTING A '1' 

IT WILL APPEAR TO BE WORKING, SAMETHING WITH A '0' INPUT OR OUTPUTS."; 
1720 PRINT8990,"TAP 'ENTER' TO CONTINUE"; 
1725 A$=INKEY?:IF A$="" THEN 1725 
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1726 


CLS: 


1738 


PRINT826 8, 


1740 


PRINT8272, 


1750 


PRINT8273, 


1760 


PRINT8276, 


1770 


PRINT8337 , 


17 80 


PRINT8336, 


1790 


PRINT8340, 


1600 


PRINT8400, 


1810 


PRINT8396, 


1820 


PRINT8401, 


1830 


PRINT8404, 


1840 


PRINT8341, 


1850 


PRINT8343, 


1860 


PR1NT8407, 


1870 


PRINT8408, 


1880 


PRINT8411, 


1890 


PRINT8475, 


1900 


PRINT8347, 


1910 


PRINT8476, 


1920 


PRINT8479, 


1930 


PRINT8415, 


1940 


PRINT8412, 


1950 


PRINT8416, 


1960 


PRINT8420, 


1970 


PRINT8460, 


1980 


PRINT8285, 


1990 


PRINT8588, 


2000 


PRINT8292, 


2010 


PRINT8652, 


2020 


PRINT8356 , 


2030 


PRINT8780, 


2040 


PRINT8420, 


2050 


PRINT8844, 


2060 


PRINT8481, 


2070 


PRINT8972, 


2080 


PRINT8545, 


2090 


PRINT8464, 


2100 


PRINT8528, 


2110 


PRINT8592, 


2120 


PRINT8465, 


2130 


PRINT8593, 


2140 


PRINT8596, 


2150 


PRINT8532, 


2160 


PRINT846 8, 


2170 


PRINT8533, 


2180 


PRINT8535, 


2190 


PRINT8471, 


2200 


PRINT6472, 


2210 


PRINT8347, 


2220 


PRINT8411, 


2230 


PRINT8475, 


2240 


PRINT8476, 


2250 


PRINT8529, 


2260 


PRINT6656, 


2270 


PRINT8720, 


2280 


PRINT8784, 


2290 


PRINT8785, 


2300 


PRINT8657, 


2310 


PRINT8660, 


2320 


PRINT8724, 


2330 


PRINT8788, 


2340 


PRINT8725, 


2350 


PRINT8721, 


2360 


PRINT8848, 


2370 


PRINT6849, 


2380 


PRINT8977, 


2390 


PRINT8912, 


2400 


PRINT8976, 


2410 


PRINT8852, 


2420 


PRINT8916, 


2430 


PRINT8980, 


2440 


PRINT8917, 


2450 


PRINT8913, 


2460 


PRINT8919, 


2470 


PRINT8855, 


2480 


PRINT8791, 


2490 


PRINT8731, 


2500 


PRINT8795, 


2510 


PRINT8859, 


2520 


PRINT8799, 


2530 


PRINT8735, 


2540 


PRINT8800, 


2550 


PRINT8796, 


2560 


PRINT8674, 


2570 


PRINT8675, 


2580 


PRINT8547, 



STRINGS 
STRINGS 
STRINGS 
STRINGS 
"0R1"; 
STRINGS 
STRINGS 
STRINGS 
STRINGS 
STRINGS 
STRINGS 
STRINGS 
STRINGS 
STRINGS 
STRINGS 
STRINGS 
STRINGS 
STRINGS 
STRINGS 
STRINGS 
STRINGS 
"AN1"; 
STRINGS 
STRINGS 
STRINGS 
STRINGS 
.STRINGS 
.STRINGS 
STRINGS 
.STRINGS 
STRINGS 
STRINGS 
rSTRINGS 
STRINGS 
.STRINGS 
STRINGS 
STRINGS 
.STRINGS 
, STRINGS 
.STRINGS 
.STRINGS 
.STRINGS 
.STRINGS 
.STRINGS 
.STRINGS 
.STRINGS 
.STRINGS 
.STRINGS 
.STRINGS 
.STRINGS 
.STRINGS 
.STRINGS 
."NOl"; 
STRINGS 
.STRINGS 
.STRINGS 
-STRINGS 
STRINGS 
STRINGS 
.STRINGS 
-STRINGS 
STRINGS 
"OR2"; 
STRINGS 
STRINGS 
STRINGS 
STRINGS 
STRINGS 
STRINGS 
STRINGS 
STRINGS 
STRINGS 
"N02"; 
STRINGS 
STRINGS 
STRINGS 
STRINGS 
STRINGS 
STRINGS 
STRINGS 
STRINGS 
STRINGS 
"AN2"; 
STRINGS 
STRINGS 
STRINGS 



CHRS (176)) 
CHRS(188)) 
CHRS (140)) 
CHRSU88)) 

CHRS (191)) 
CHRSU9D) 
CHRSU43)) 
CHRSU31)) 
CHRSU40)) 
CHRSU43)) 
CHRSU40)) 
CHRSU88)) 
CHRSU31)) 
CHRS (131)) 
CHRSI191)) 
CHRS (191)) 
CHRS (176)) 
CHRSI176)) 
CHRSU9D) 
CHRS(19D) 

CHRS (176)) 
CHR5(176)) 
CHRS (176)) 
CHRS (131)) 
CHRS (131)) 
CHRS (191)) 
CHRS (176)) 
CHRS (191)) 
CHRSU3U) 
CHRS(191)) 
CHRS (176)) 
CHRS (191)1 
CHRS (131)) 
CHRSU31)) 
CHRS (188)) 
CHRSU91)) 
CHRS(143)) 
CHRS(140)) 
CHRSU40)) 
CHRS (143)1 
CHRS (191)) 
CHRS (188)1 
CHRS (140)1 
CHRS (143)) 
CHRS (188)) 
CHRS (140)1 
CHRS (1761) 
CHRS (1911) 
CHRS (191)1 
CHRS (1761) 

CHRS (1881) 
CHRS (191)) 
CHRS (143)) 
CHRS (140)) 
CHRS (140)) 
CHRS (188)) 
CHR$(191)) 
CHRS (143)) 
CHRSI140)) 

CHRS (1881) 
CHRS (140)) 
CHR5(140)) 
CHRS (191)) 
CHRSU43)) 
CHRSU88)) 
CHRSI191)) 
CHRS (143)) 
CHRS (140)) 

CHRSU43)) 
CHRS (191)) 
CHRS (176)) 
CHRS (191)) 
CHRSU91)) 
CHRS (131)) 
CHRS1191)) 
CHRSI191)) 
CHRS(13D) 

CHRS(191)) 
CHRS (176)) 
CHRS (131)) 
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2590 PRINT8804,STRINGS(2,CHRS(131)) ; 

2600 PRINT8674 .STRINGS U,CHR$ (176) > ; 

2610 PRINT8673,STRINGS(1,CHRS(176)>; 

2620 PRINT8747,STRINGS(5,CHRS(140)); 

2630 PRINT8491, STRINGS (5, CHRS (140)); 

2640 PRINT8422,STRINGS(1,CHRS(188)); 

2650 PRINT8486,STRINGS(1,CHRS(19D); 

2660 PRINT@550,STRINGS(1, CHRS (143)); 

2670 PRINT8551,STRING$(3,CHRS(140)) ; 

2680 PRINT8423,STRINGS(3,CHRS(140)); 

2690 PRINT8426,STRINGS(1,CHRS(188)) ; 

2700 PRINT8490,STRING$(1,CHRS(191)) ; 

2710 PRINT8554,STRING$(1,CHRS(143)); 

2720 PRINT8742, STRINGS (1,CHR$ (191)); 

2730 PRINT8678,STRINGS(1,CHRS(188)) ; 

2740 PRINT8806, STRINGS (1, CHRS (143)); 

2750 PRINT@932,STRING$(1,CHR$(19D) ; 

2760 PRINT8807,STRINGS(3,CHRS(140)) ; 

2770 PRINT8868, STRINGS (1, CHRS (191)); 

27 80 PRINT8679,STRING$(3,CHRS(140)>; 

27 90 PRINT8804,STRING$(1,CHRS<191>>; 

2800 PRINT8746, STRINGS (1, CHRS (191)); 

2810 PRINT8737,STRINGS(1,CHRS(19U); 

2820 PRINT8682,STRINGS(1,CHR$(188)); 

2830 PRINT8810,STRINGS(1, CHRS (143)); 

2840 PRINT8743,"NA2"; 

2850 PRINT8487,"NA1"; 

2860 PRINT8732,STRING$(3,CHRS(131)) ; 

2870 PRINT8927,STRING$(5,CHRS(176) ) ; 

2880 PRINT8006, "INSERT THE GATE INPUTS ON THE LEFT. 

2890 PRINT8192, "INPUTS"; 

2900 PRINT8246, "OUTPUTS"; 

2910 PRINT8256,"0R1A" 

2920 PRINT8216,"NA1A"; 

2930 PRINT8320,"OR1B"; 

2940 PRINT8448,"N01A" 

2950 PRINT8512,"N01B" 

2960 PRINT8704,"OR2A" 

2970 PRINT8768,"OR2B" 

2980 PRINT8896,"N02A" 

2990 PRINT8960,"NO2B" 

3000 PRINT8920,"NA2B" 

3010 PRINT8310,"OR1C" 

3020 PRINT8374,"N01C"; 

3030 PRINT8438,"AN1C" 

3040 PRINT8502,"NA1C"; 

3050 PRINT8758,"OR2C" 

3060 PRINT8822,"N02C" 

3070 PRINT8886,"AN2C"; 

3080 PRINT8950,"NA2C"; 

3090 PRINT8064,"PIG.l"; 

3100 PRINT8640,"FIG.2"; 

3110 PRINT8103, "INPUT TO 0R1A";:INPUT F 

3120 IF F=l THEN 3150 

3130 PRINT8265,'"0"; 

3140 GOTO 3160 

3150 PRINT6265,"1"; 

3160 PRINT6103, "INPUT TO 0R1B";:INPUT G 

3170 IF G=l THEN 3200 

3180 PRINT8329,°0"; 

3190 GOTO 3210 

3200 PRINT6329,"1"; 

3210 IF F+G>=1 THEN 3260 

3220 LET 0=0 

3230 PRINT8316,"0"; 

3240 PRINT8345,"0"; 

3250 GOTO 3290 

3260 PRINT8316,"1"; 

3270 LET 0=1 

3280 PRINT8345,"1"; 

3290 PRINTei03, "INPUT TO N01A";:INPUT H 

3300 IF B=l THEN 3330 

3310 PRINT8457,"0"; 

3320 GOTO 3340 

3330 PRINT8457,"1"; 

3340 PRINT8103, "INPUT TO N01B";: INPUT J 

3350 IF J=l THEN 3380 

3360 PRINT8521,"0"; 

3370 GOTO 3390 

3380 PRINT8521,"1"; 

3390 IF H+J>=1 THEN 3440 

3400 PRINT8380,"1"; 

3410 LET P=l 

3420 PRINT8537,"1"; 

3430 GOTO 3470 

3440 PRINT8380,"0"; 

3450 LET P=0 
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3460 PRINT§537,"0"; 

3470 IP 0+P=2 THEN 3520 

3480 PRINT6444,"0"; 

3490 LET T=0 

3500 PRINTS418,"0"; 

3510 GOTO 3550 

3520 PRINTS444,"1" 

3530 LET T=l 

3540 PRINTe41B,"l" 

3550 PRINT8103, "INPUT TO NA1A" ;: INPUT S 

3560 IP S-l THEN 3590 

3570 PRINT8222,"0"; 

3580 GOTO 3600 

3590 PRINT§222,"1"; 

3600 IP S+T=2 THEN 3640 

3610 PRINT@508,"1"; 

3620 PRINT6430,"1"; 

3630 GOTO 3660 

3640 PRINTS508,"0"; 

3650 PRINT§430,,"0"; 

3660 GOTO 3670 

3670 PRINTS103, "INPUT TO OR2A";:INPUT K 

3680 IF K=l THEN 3710 

3690 PRINTe713,"0"; 

3700 GOTO 3720 

3710 PRINT§713,"1"; 

3720 PRINT6103, "INPUT TO OR2B";:INPUT L 

3730 IF L=l THEN 3760 

3740 PRINT8777,"0"! 

3750 GOTO 3770 

3760 PRINT8777,"1"! 

3770 IF K+L<1 THEN 3820 

37B0 PRINT6663,"1"; 

3790 PRINT6764,"1"; 

3800 LET Q=l 

3810 GOTO 3850 

3820 PRINTe663,"0") 

3830 PRINT§764,"0"; 

3840 LET Q=0 

3850 PRINT6103, "INPUT TO N02A"; : INPUT M 

3860 IF M=l THEN 3890 

3870 PRINT6905,"0"; 

3880 GOTO 3900 

3890 PRINT§905,"1"; 

3900 PRINT6103, "INPUT TO N02B";:INPUT N 

3910 IF N=l THEN 3940 

3920 PRINTS969,"0"; 

3930 GOTO 3950 

3940 PRINTe969,"l"; 

3950 IF M+N<1 THEN 4000 

3960 PRINT§828,"0"; 

3970 PRINT@857,"0"; 

3980 LET R=0 

3990 GOTO 4030 

4000 PRINTe828,"l"; 

4010 PRINTe857,"l"; 

4020 LET R=l 

4030 IF Q+R=2 THEN 4080 

4040 PRINTS672,"0"; 

4050 PRINT6892,"0"; 

4060 LET W=0 

4070 GOTO 4110 

4080 PRINT§672,"1"; 

4090 PRINT6892,"1"; 

4100 LET W=l 

4110 PRINT6103, "INPUT TO NA2B";:INPUT X 

4120 IF X=l THEN 4150 

4130 PRINT@925,"0"; 

4140 GOTO 4160 

4150 PRINTS925,"1"; 

4160 IF W+X=2 THEN 4200 

4170 PRINT6684,"1"; 

4180 PRINT§956,"1"; 

4190 GOTO 4220 

4200 PRINTe6 84,"0"; 

4210 PRINT6956,"0"; 

4220 PRINTS006,"REDO FIGS.l 6 2 7 TYPE Y FOR YES OR N FOR NO"; 

4230 INPUTYS:IFLEFTS(YS,1)="N" GOTO 4250 ELSEIFLEFT? (Y$,l) <> "Y" THEN 42 

40 
4240 GOTO 1725 

4250 PRINT§006,"REDO JUST FIG.l ? TYPE Y FOR YES OR N FOR NO"; 
4260 INPUTY$: IF LEFTS <Y$,1)="N" GOTO 4290 ELSEIFLEFT$ (Y?,l) <> "Y" THEN 42 

70 
4270 GOSUB 50010 
4280 GOTO 1730 

4290 PRINT§006,"REDO JUST FIG. 2 ? TYPE Y FOR YES OR N FOR NO"; 
4300 INPUTY$: IF LEFT?(»$,1)= "N" GOTO 4350 ELSEIFLEFTS (YS, 1) <> "Y" THEN 4310 
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4310 GOSUB 60010 

4320 GOTO 3670 

4350 CLS: PRINT607 , "REVIEW THIS COURSE OFTEN AND BUILD A SOLIDFOUNDATION OF THE 

BASICS THEN GO OUT AND ENJOY ELECTRONICS EITHER AS A HOBBY AND/OR" 
4360 PRINT§262,"A PROFESSION. tHERE IS 'NO END' TO WHAT CAN BE CREATED THRU TH 

E HIND OF MAN AND ELECTRONICS." 
4370 GOTO 4370 
30000 END 

30010 REM * BASIC GATE DIAGRAM * 
30020 PRINTS458, STRINGS (13, CHRS (131)); 
30030 PRINT@714,STRINGS(13,CHRSU3U) ; 
30040 PRINT6599,STRINGS(8,CHRS(131) ) ; 
30050 PRINTS518, STRINGS (4, CHRS (131)) 
30060 PRINM646, STRINGS ( 4, CHRS (131)) 
30070 PRINT@537,"C" 
30080 PRINT8451,"A 
30090 PRINT6579,"B 

30100 PRINTS534, STRINGS (1, CHRS (170)) 
30110 PRINTS662, STRINGS (1, CHRS (170)) 
30120 PRINTS598, STRINGS (1, CHRS (170)) 
30130 PRINTS470, STRINGS (1, CHRS (171)) 
30140 PRINT8458, STRINGS (1, CHRS (151)) 
30150 PRINT8522, STRINGS (1, CHRS (149)) 
30160 PRINT8586, STRINGS (1, CHRS (149)) 
30170 PRINTS65 0, STRINGS (1, CHRS (149)) 
30180 RETURN 
40000 END 

40010 REM * TRUTH TABLE FRAMING * 
40020 PRINTS242, "TRUTH TABLE"; 
40030 PRINT6306,"A B C" 
40040 PRINT6368,"- 
40050 PRINT6496,"- 
40060 PRINT6624,"- 
40070 PRINT8752,"- 
40080 RETURN 
50000 END 
50010 PRINTS265," 
50020 PRINTS329," 
50030 PRINTS316," 
50040 PRINTS345," 
50050 PRINT6457," 
50060 PRINT6521," 
50070 PRINT6380," 
50080 PRINT8444," 
50090 PRINT8537," 
50100 PRINT5418," 
50110 PRINT6222," 
50120 PRINT9508," 
50130 PRINTS430," 
50140 RETURN 
60000 END 
60010 PRINT6713," 
60020 PRINT8777," 
60030 PRINTS663," 
60040 PRINT6764," 
60050 PRINT6905," 
60060 PRINT6969," 
60070 PRINT8828," 
60080 PRINT8857," 
60090 PRINT8672," 
60100 PRINT6892," 
60110 PRINTS925," 
60120 PRINTS684," 
60130 PRINT8956," 
60140 RETURN 
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ELECTRIC HEATING ESTIMATE PROGRAM: by fl obert Roy 



Type in your data and get your 
choice of a quick, ballpark 
estimate or a detailed room by 
room estimate of your home's 
heat loss. Losses through walls, 
ceilings, windows, floors, etc. 
are considered. Supply your 
local electric utility rates and 
you'll receive an annual cost 
estimate. No need to do the latter 
part of the program if you're 
faint of heart. 



toss iflTOiimnctt scu. men 



loss wu mum* 

LOSS IHiUMOiS 
LOSS IHiUKUS 
LOSS DM CEILING 
LOSS mi SUB 
LOSS BY Ilf 1L1MTI0M 
FlISFUff HEfl! LOSS 
TOTAL IQT LOSS FH W6E 



IIS *fl 5 

M WTT5 
K72KI I*" 5 

23.i unrrs 

tm »ff 5 

W HHTTS 

7«9 USfTS 
5M881 I* 115 ', 



MUSTD F* OUISIK ESISI TBKBinK 1 

ESTIWTFJ awmiM IS 1 HI HUB Ft* ™' 

10 YOU WISH ft COST ESIllWt) 

IF YK. DHtS*l'. IF HO, tKltH'Z'i? - 



10 CLEAR250 
20 Z$="####.»" 

30 F1(1)=8:F1(2)=11.8:F1(3)=23 

40 F2(1)=6.1:F2(2)=3.6:F2(3)=10.1 

50 F3(1)=5.28:F3(2)=2.1:F3(3)=1.28:F3(4)=.91:F3(5)=2 

60 F4(1)=11.5:F4(2)=2.31:F4(3)=1.4:F4(4)=.99:F4(5)=.59:F4(6)=.52:F4(7)=0 

70 F5(1)=8.44:F5(2)=4.55:F5(3)=1.33:F5(4)=.96:F5(5)=0 

80 P5(1)=20:P5(2)=8:P5(3)=4:P5(4)=2 

90 F6(1)=.5:F6(2)=.4:F6(3)=.325:F6(4)=.275:F6(5)=.225:F6(6)=.04 

100 F7(1)=3700:F7(2)=1250:F7(3)=500 

110 CLS 

120 PRINT"*** ELECTRIC hEATING ESTIMATE PROGRAM ***" 

130 PRINT:PRINT" ":PRINT 

140 PRINT"USE TABLE ONE TO DETERMINE OUTSIDE DESIGN TEMPERATURE AND" 

150 PRINT'ANNUAL DEGREE DAYS FOR YOUR AREA. (USE LOCATION CLOSEST" 

160 PRINT" TO YOUR OWN.)":PRINT 

170 INPUT'THE OUTSIDE DESIGN TEMP. IS ",-D 

180 INPUT'THE ANNUAL DEGREE DAYS ARE ";DG 

190 TD=65-D 

200 IFTD=<65THENC=17 

210 IFTD>65THENC=15 

220 IFD=5THENDM=.93 

230 IFD=10THENDM=.86 

240 IFD=15THENDM=.79 

250 IFD=20THENDM=.72 

260 IFD=25THENDM=.65 

270 IFD=30THENDM=.57 

280 IFD=35THENDM=.51 

290 IFD=40THENDM=.44 

300 IFD=0THENDM=1 

310 IFD=~5THENDM=1.07 

320 IFD=-10THENDK=1.15 

330 IFD=-15THENDM=1.22 

340 IFD=-20THENDH=1.29 

350 IFD=-25THENDM=1.36 

360 IFD=-30THENDM=1.43 

370 IFD=-35THENDM=1.5 

380 IFD=-40THENDM=1.57 

390 CLS 

400 PRINT'WOULD YOU LIKE:":PRINT 

410 PRINT" 1- A QUICK BALLPARK ESTIMATE FOR THE WHOLE HOUSE" 

420 PRINT" OR" 

430 PRINT" 2- AN ACCURATE ROOM-BY-ROOM ESTIMATE" 

440 PRINT 

450 INPUT"ENTER CHOICE NUMBER (1 OR 2)", -XX 

460 ONXXGOTO3290,470 

470 CLS 

480 PRINT: PRINT"SECTION OFF ANY NON-RECTILINEAR ROOMS IN FLOOR" 

490 PRINT"PLAN INTO RECTANGLES ON DRAWING. NUMBER ALL ROOMS" 

500 PRINT"(OR CREATED RECTILINEAR AREAS) SEQUENTIALLY, I.E.:1-15" 

510 PRINT:PRINT"DO THE ABOVE FOR ALL FLOORS IN BUILDING," 

520 PRINT"CONTINUING THE SEQUENTIAL NUMBERING (I.E.: 16-27)." 

530 PRINT: INPUT"HOW MANY AREAS" ;R 

540 CLS 
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550 INPUT'HOW MANY AREAS HAVE EXTERIOR DOORS" ;RA 

560 PRINT:PRINT"IN RESPONSE TO 'AREA NUMBER?', ENTER THE NUMBER OF ONE" 

570 PRINT'AREA WITH EXTERIOR DOORS. tHIS QUESTION WILL BE ASKED" 

580 PRINTTAB(20);RA;" TIME(S)." 

590 FORB=lTORA 

600 PRINT: INPUT"AREA NUMBER" ;N (B) 

610 NEXTB 

620 CLS 

630 PRINT: INPUT"HOW MANY FIREPLACES IN THIS HOUSE";FZ 

640 IFFZ=0GOTO780 

650 PRINT:PRINT"IN RESPONSE TO 'AREA NUMBER?', ENTER THE NUMBER OF ONE" 

660 PRINT"AREA WHICH HAS A FIREPLACE. tHIS QUESTION WILL BE ASKED" 

670 PRINTTAB(20);FZ;" TIME(S)." 

6 80 FORB=lTOFZ 

690 PRINT: INPUT"AREA NUMBER";Z(B) 

700 NEXTB 

710 CLS 

720 PRINT"DO ALL AREAS HAVE THE SAME WALL INSULATION?" 

730, PRINT: INPUT"ENTER '1' IF YES, ENTER '2' IF NO";ZW 

740 IFZW=2GOTO760 

750 GOSUB4050 

7 60 CLS 

770 PRINT:PRINT"DO ALL AREAS HAVE THE SAME CEILING HEIGHT?" 

780 PRINT: INPUT"ENTER '1' IF YES, '2' IF NO";ZX 

790 IFZX=2GOTO810 

800 PRINT: INPUT"HHAT IS THE TYPICAL CEILING HEIGHT";ZC 

810 CLS 

820 PRINT:PRINT"DO ALL THE WINDOWS IN THE HOUSE HAVE THE SAME CONSTRUCTION?" 

830 PRINT"(I.E. ALL SINGLE PANE, ALL DOUBLE PANE, ETC.)" 

840 PRINT: INPUT"ENTER '1' IF YES, '2' IF NO";ZY 

850 IFZY=2GOTO910 

860 PRINT:PRINT"KHAT CLASS OF WINDOW IS TYPICAL FOR THIS HOUSE:" 

870 PRINT:PRINT"1- TRIPLE PANE" 

880 PRINT"2- DOUBLE PANE (OR SINGLE PANE WITH STORM SASH) " 

890 PRINT"3- SINGLE PANE" 

900 PRINT: INPUT"ENTER CLASS NUMBER" ;ZD 

910 IFZD>3GOT0868 

920 CLS 

930 PRINT'DO YOU WISH TO CONSIDER THE INFILTRATION" 

940 PRINT"CLASS THE SAME FOR ALL AREAS?" :PRINT 

950 INPUT"ENTER '1' IF YES, '2' IF NO";ZZ 

960 IFZZ=2GOTO1040 

970 PRINT:PRINT"WHICH CLASS OF BUILDING CONSTRUCTION FOR THIS HOUSE?" 

980 PRINT:PRINT"1- DRAFTY (MORE THAN ONE FULL AIR CHANGE PER HOUR)" 

990 PRINT"2- POOR TO NORMAL" 

1000 PRINT"3- NORMAL (3/4 TO 1 FULL AIR CHANGE PER HOUR)" 

1010 PRINT"4- NORMAL TO GOOD" 

1020 PRINT"5- 'TIGHT' (1/2 FULL AIR CHANGE PER HOUR)" 

1030 PRINT: INPUT'ENTER CLASS NUMBER" ;ZE 

1040 IFZE>5GOTO970 

1050 FORA=lTOR 

1060 CLS 

1070 PRINT"FOR AREA *";A 

1080 PRINT: INPUT'ENTER DESCRIPTION OF AREA";DSS(A) 

1090 INPUT"ENTER THE DIMENSIONS OF THE AREA (SEPARATE BY COMMA) ";L(A) ,W(A) 

1100 IFZX=1THENCH(A)=ZC 

1110 IFZX=1THENGOTO1130 

1120 INPUT"WHAT IS THE CEILING HEIGHT" ;CH(A) 

1130 INPUT"HOW MANY EXTERIOR WALLS THIS AREA":WN(A) 

1140 IFWN(A)=0GOTO1760 

1150 CLS 

1160 FORB=lTOWN (A) 

1170 ONBGOTO1190, 1200, 1210, 1220 

1180 IFB>4THENGS="NEXT":GOTO1230 

1190 G$="FIRST":GOTO1230 

1200 GS="SECOND":GOTO1230 

1210 G$="THIRD":GOTO1230 

1220 G$="FOURTH" 

1230 PRINT: PRINT "ENTER LENGTH OF ";GSj" EXTERIOR WALL"; 

1240 INPUTLW(B) 

1250 K(A)=K(A1+LW(B) 

1260 LE(A)=LE(A)+LW(B) 

1270 NEXTB 

1280 CLS 

1290 IFA=Z(1)ORA=Z(2)ORA=Z(3)ORA=Z(4)ORA=Z(5)GOSUB4140 

1300 CLS 

1310 INPUT"HOW MANY WINDOWS THIS AREA" ;WY (A) : PRINT 

1320 IFWY(A)=0GOTO1590 

1330 FORB=lTOWY(A) 

1340 ONBGOTO1360, 1370, 1380, 1390, 1400 

1350 IFB>5THENG$="NEXT":IFB>5GOTO1410 

1360 G?="FIRST":GOTO1410 

1370 G$="SECOND":GOTO1410 

1380 G$="THIRD":GOTO1410 

1390 GS="FOURTH":GOTO1410 

1400 GS="FIFTH" 

1410 PRINT"ENTER HEIGHT, WIDTH OF ";GS;" WINDOW (IN INCHES)"; 
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1420 INPUTWK(B) ,WJ(B) 

1430 IFZY=1THENWR(B)=ZD 

1440 IFZY=1THENGOTO15 20 

1450 PRINT'WHAT CLASS OF WINDOW:" 

1460 PRINT:PRINT"1- TRIPLE PANE" 

1470 PRINT"2- DOUBLE PANE (OR SINGLE PANE WITH STORM SASH) " 

1480 PRINT"3- SINGLE PANE" 

1490 IFN=9GOTO3530 

1500 PRINT: INPUT"ENTER CLASS NUMBER" ;WR(B) 

1510 IFWR(B)>3GOTO1450 

1520 WS(B)=WK(B)*WJ(B)/144 

1530 W1(A)=W1(A)+WS(B) 

1540 LS(B)=WS(B)*F1(WR(B)) 

1550 L1(A)=L1(A)+LS(B) 

1560 CLS 

1570 NEXTB 

1580 L1=L1+L1(A) 

1590 CLS 

1600 IFA<>N(1)ANDA<>N(2)ANDA<>N(3)ANDA<>N(4)ANDA<>N(5)ANDAON(6)ANDAON(7)GOT017 

60 

1610 INPUT"HOW MANY EXTERIOR DOORS IN THIS AREA";DD(A) 

1620 FORB=1TODD(A) 

1630 PRINT"WHICH CLASS IS DOOR S";B 

1640 PRINT: PRINT"1- WOOD OR METAL WITH STORM DOOR" 

1650 PRINT"2- FOAM FILLED" 

1660 PRINT"3- SOLID WOOD" 

1670 PRINT: INPUT"ENTER CLASS NUMBER" ;DR(B) : PRINT 

1680 IFDR(B)>3GOTO1700 

16 90 GOTO1710 

1700 PRINT"RE-ENTER CLASS NUMBER" :PRINT:GOTO1630 

1710 LD(B)=20*F2(DR(B)) 

1720 L2(A)=L2(A)+LD(B) 

1730 NEXTB 

1740 L2=L2+L2(A) 

1750 AD(A)=DD(A)*20 

1760 CLS 

1770 IFZZ=1THENFH(A)=ZE 

17 80 IFZZ=1GOTO1910 

1790 PRINT" INFILTRATION FACTOR:" 

1800 PRINT" " 

1810 PRINT:PRINT"WHICH CLASS OF BUILDING CONSTRUCTION HERE:" 

1820 PRINT: PRINT'l- DRAFTY (MORE THAN 1 FULL AIR CHANGE PER HOUR)" 

1830 PRINT"2- POOR TO NORMAL" 

1840 PRINT"3- NORMAL (3/4 TO 1 FULL AIR CHANGE PER HOUR) " 

1850 PRINT"4- NORMAL TO GOOD" 

1860 PRINT"5- 'TIGHT' (1/2 FULL AIR CHANGE PER HOUR)" 

1870 IFN=9GOTO36 80 

1880 PRINT"6- BASEMENT AREA" 

1890 PRINT: INPUT"ENTER CLASS NUMBER" ; FH (A) 

1900 IFFH(A1>6GOTO1810 

1910 L6 (A) =L(A) *W(A) *CH(A) *F6 (FH(A) ) 

1920 L6=L6+L6(A) 

1930 CLS 

1940 PRINT"FLOOR INSULATION FACTOR:" 

1950 PRINT" " 

1960 PRINT"IS THE FLOOR A CONCRETE SLAB?" 

1970 INPUT"1F YES, ENTER '1'. iP NO, ENTER '2'";S 

1980 IFS=1GOTO2100 

1990 PRINT :PRINT"WHICH CLASS OF CONSTRUCTION:" 

2000 PRINT:PRINT"1- DOUBLE WOOD ONLY" 

2010 PRINT"2- DOUBLE WOOD WITH CARPET AND PAD" 

2020 PRINT"3- DOUBLE WOOD WITH 3-5/8" FIBERGLAS (R13) " 

2030 PRINTM- DOUBLE WOOD WITH 6" FIBERGLAS (R19)" 

2040 IFN=9GOTO3620 

2050 PRINT"5- ANOTHER FLOOR OR BASEMENT BELOW" 

2060 PRINT: INPUT"ENTER CLASS NUMBER" ; FF (A) 

2070 IFFF(A) >5GOTO1990 

2080 L5(A)=L(A)*W(A)*F5(FF(A)) 

2090 GOTO2190 

2100 PRINT:PRINT"WHICH CLASS OF CONSTRUCTION:" 

2110 PRINT: PRINT"1- UNINSULATED SLAB" 

2120 PRINT"2- INSULATED SLAB (R5)" 

2130 PRINT"3- INSULATED SLAB (R10)" 

2140 PRINT"4- BASEMENT SLAB" 

2150 IFN=9GOTO3650 

2160 PRINT: INPUT"ENTER CLASS NUMBER" ; FG (A) 

2170 IFFG(A)>3GOTO2100 

2180 L5(A)=K(A)*P5(FG(A)) 

2190 L5=L5+L5(A) 

2200 CLS 

2210 IFZW=1THENWF(A)=ZB 

2220 IFZW=1GOTO23 40 

2230 PRINT'EXTERIOR WALL INSULATION FACTOR:" 

2240 PRINT"- -" 

2250 PRINT:PRINT"WHICH CLASS OF INSULATION:" 

2260 PRINT:PRINT"1- SHEATHING, SHEETROCK, NO INSULATION" 

2270 PRINT"2- R7 INSULATION" 
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2280 PRINT"3- SHEATHING, SHEETROCK, R13 INSULATION" 

2290 PRINT"4- SHEATHING, SHEETROCK, R19 INSOLATION" 

2300 PRINT'S- UNINSULATED BASEMENT WALL" 

2310 IFN=9GOTO3480 

2320 PRINT: INPUT"ENTER CLASS NUMBER" ;WF (A) 

2330 IFWF(A)>4GOTO2250 

2340 WA(A) =LE(A) *CH ( A) -Wl (A) -AD (A) 

2350 L3(A)=WA(A)*F3{WF(A)) 

2360 L3=L3+L3(A) 

2370 CLS 

2380 PRINT"CEILING INSULATION FACTOR:" 

2390 PRINT"- " 

2400 PRINT: PRINT"WHICH CLASS OF INSULATION:" 

2410 PRINT: PRINT'l- SHEETROCK WITH NO INSULATION" 

2420 PRINT"2- SHEETROCK WITH 1-5/8" FIBERGLAS (R7) " 

2430 PRINT"3- SHEETROCK WITH 3-5/8" FIBERGLAS (R13) " 

2440 PRINT"4- SHEETROCK WITH 6" FIBERGLAS (R19)" 

2450 PRINT"5- SHEETROCK WITH 10" FIBERGLAS (R33) " 

2460 PRINT"6- SHEETROCK WITH 12" FIBERGLAS (R38)" 

2470 IFN=9GOTO3560 

2480 PRINT"7- ANOTHER ROOM ABOVE" 

2490 PRINT: INPUT"ENTER CLASS NUMBER" ;CF (A) 

2500 IFCF(A)>7GOTO2400 

2510 CA(A)=L(A)*W(A) 

2520 L4(A)=CA(A)*F4(CF(A)) 

2530 L4=L4+L4(A> 

2540 CLS 

2550 NEXTA 

2560 FORA=1TOR 

2570 PRINT"AREA DESCRIPTION: " ;DS$ (A) : PRINT 

2580 PRINT"DIMENSIONS:";TAB(30) ;L(A) ;" X ";W(A);" FT." 

2590 PRINT'CEILING HEIGHT: " ;TAB(30) ;CH!A) ; " FT." 

2600 PRINT"GROSS EX. WALL AREA: " ;TAB(30) ;LE (A) *CH(A) ; " SQ. FT." 

2610 PRINT"TOTAL NO. OF WINDOWS: ";TAB{30) ;WY(A) 

2620 PRINT"TOTAL WINDOW AREA: ",-TAB(30) ;W1(A) ,- " SQ. FT." 

2630 PRINT"TOT. NO. EX. DOORS: ";TAB(30) :DD(A) 

2640 PRINT'TOT. EX. DOOR AREA: "TAB(30) ; AD(A) ; " SQ. FT." 

2650 PRINT"NET EX. WALL AREA: ";TAB(30) ;LE(A) *CH(A) -Wl (A)-AD(A) ; " SQ. FT." 

2660 PRINT"CEILING AREA: ";TAB(30) ,-CA(A) ; " SQ. FT." 

2670 PRINT"FLOOR AREA: ";TAB(30) (L(A) *W(A) ; " SQ. FT." 

2680 PRINT"CUBIC FEET: " ;TAB(30) :L (A) *W(A) *CH (A) ,- " CU. FT." 

2690 IFAOZ(B)GOTO2760 

2700 ONQ(A)GOTO2710, 2730, 2750 

2710 PRINT"THE FIREPLACE IN THIS AREA HAS NO DAMPER" 

2720 GOTO2760 

2730 PRINT"THE FIREPLACE IN THIS AREA HAS A LOOSE-FITTING DAMPER" 

27 40 GOTO2760 

2750 PRINT"THE FIREPLACE IN THIS AREA HAS A GOOD DAMPER" 

2760 PRINT: INPUT"PRESS 'ENTER' TO CONTINUE";A$ 

2770 CLS 

2780 PRINT"WATTS LOSS THROUGH: " :PRINT 

2790 PRINT" WINDOWS: ";L1(A) 

2800 PRINT" DOORS: ":L2(A) 

2810 PRINT" EX. WALLS: ";L3(A) 

2820 PRINT" CEILING: ";L4(A) 

2830 PRINT" FLOOR: n :L5(A) 

2840 PRINT" INFILTRATION: ";L6(A) 

2850 PRINT" FIREPLACE: ";L7(A) 

2860 TL ( A) =L1 ( A) +L2 (A) +L3 ( A) +L4 (A) +L5 (A) +L6 ( A) +L7 { A) 

2870 PRINT: PRINT "TOTAL WATTS LOSS FOR THIS AREA: ";TL(A) 

2880 PRINT"aDJUSTED FOR OUTSIDE DESIGN TEMPERATURE";TAB(42) ;TL(A) *DM 

2890 PRINT:PRINT" ( ";TL(A) *DM*3.413; " B.T.U.'S )" 

2900 PRINT: INPUT"PRESS 'ENTER' TO CONTINUE";A$ 

2910 CLS 

2920 NEXTA 

2930 CLS 

2940 F0RA=1T0R 

2950 T=T+TL(A) 

2960 NEXTA 

2970 PRINT" * HEAT LOSS SUMMATION *":PRINT 

2980 PRINT"SOURCE";TAB(21) ; "DESIGN" ;TAB(33) ,- "LOCATION", -TAB (46) ,-"% 0F" 

2990 PRINTTAB(21) ; "HEAT";TAB(33) ; "ADJUSTED";TAB(46) ["TOTAL" 

3000 PRINTTAB(21),-"LOSS";TAB(33);"LOSS":PRINT 

3010 PRINT"WINDOWS"iTAB(20);Ll;TAB(32);Ll*DM;TAB(45);:PRINT USINGZ$,-L1*100/T 

3020 PRINT"DOORS";TAB(20);L2;TAB(32);L2*DM;TAB(45);:PRINTUSINGZ$,-L2*100/T 

3030 PRINT"wALLS";TAB(20);L3;TAB(32),-L3*DM;TAB(45);:PRINTUSINGZS;L3*100/T 

3040 PRINT"ROOF";TAB(20);L4;TAB(32);L4*DM:TAB(45);:PRINTUSINGZ5;L4*100/T 

3050 PRINT"FLOOR";TAB(20),-L5;TAB(32);L5*DM;TAB(45);:PRINTUSINGZ$;L5*100/T 

3060 PRINT"INFILTRATION";TAB(20);L6;TAB(32);L6*DM;TAB(45);:PRINTUSINGZS;L6*100/T 

3070 PRINT"FIREPLACES";TAB(20);L7;TAB(32);L7*DM;TAB(45);:PRINTUSINGZ$;L7*100/T 

3080 INPUT"PRESS 'ENTER' TO CONTINUE" ;AS 

3090 CLS 

3100 PRINT"THE TOTAL DESIGN HEAT LOSS FOR THIS HOUSE IS:" 

3110 PRINT:PRINTTAB(20) ;T;" WATTS." 

3120 PRINT:PRINT 

3130 T=T*DM 

3140 PRINT"THE TOTAL ADJUSTED HEAT LOSS FOR THIS HOUSE IS:" 
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3150 PRINT:PRINTTAB(20);T;" WATTS." 

3160 PRINT:PRINT" ( ";T*3.413;" B.T.U.'S )":PRINT 

3170 KW=(T*DG*C)/(1000*TD) 

3180 PRINT"ESTIHATED CONSUMPTION IS ";KW;" KW HOURS PER YEAR." 

3190 PRINT :PRINT"DO YOU WISH A COST ESTIMATE?" : PRINT 

3200 INPUT"IF YES, ENTER '!'. IF NO, ENTER '2'.";M 

3210 CLS 

3220 IFM=2GOTO3270 

3230 INPUT"ENTER UTILITY RATE (I.E. FOUR CENTS PER KW HOUR = .04)";PX 

3240 RB=KW*PX 

3250 RC=FIX(RB) 

3260 PRINT:PRINT"THE ESTIMATED ANNUAL COST OF OPERATION IS: $";RC 

3270 PRINT:PRINT"THE PROGRAM IS CONCLUDED." 

3280 END 

3290 CLS 

3300 N=9 

3310 PRINT"THIS BALLPARK ESTIMATE IS BASED ON THE NEMA (1962)" 

3320 PRINT" SHELL METHOD" 

3330 PRINT: INPUT"ENTER PERIMETER OF HOUSE", -PP 

3340 PRINT: INPUT"ENTER GROUND FLOOR AREA OF HOUSE"jAA 

3350 PRINT: INPUT"ENTER HEIGHT TO ROOF INSULATION" ;CH 

3360 CLS 

3370 PRINT: INPUT"ENTER APPROXIMATE TOTAL AREA OF WINDOWS";WA 

3380 PRINT: INPUT"ENTER NUMBER OF EXTERIOR DOORS" fDD 

3390 PRINT: INPUT"ENTER NUMBER OF FIREPLACES" ;F 

3400 IFF=0GOTO3470 

3410 PRINT:PRINT"DO THE FIREPLACE(S) HAVE:" 

3420 PRINT:PRINT"1- NO DAMPER(S) AT ALL" 

3430 PRINT"2- POOR (LOOSE-FITTING) DAMPER(S)" 

3440 PRINT"3- GOOD (SNUG) DAMPER(S)" 

3450 PRINT :INPUT"ENTER '1', '2', OR '3'";DP 

3460 IFDP>3GOTO3410 

3470 GOTO2200 

3480 PRINT: INPUT"ENTER CLASS NUMBER" ;WF 

3490 IFWF>4GOTO223 

3500 CLS 

3510 PRINT'WHAT CLASS OF WINDOW IS PREDOMINANT IN THE HOUSE?" :PRINT 

3520 GOTO1460 

3530 PRINT: INPUT"ENTER CLASS NUMBER";WR 

3540 IFWR>3GOTO3510 

3550 GOTO2370 

3560 PRINT: INPUT"ENTER CLASS NUMBER";CF 

3570 IFCF>6GOTO3550 

3580 CLS 

3590 PRINT" IS THE FIRST FLOOR BUILT ON A SLAB?" 

3600 PRINT: INPUT'IF YES, ENTER '1'. IF NO, ENTER '2'";S 

3610 GOTO1980 

3620 PRINT"5- BASEMENT BELOW" 

3630 PRINT: INPUT"ENTER CLASS NUMBER" ;FF 

3640 GOTO3670 

3650 PRINT: INPUT"ENTER CLASS NUMBER" ; FG 

3660 IFFO3GOTO2100 

3670 GOTO1760 

3680 PRINT: INPUT'ENTBR CLASS NUMBER";FH 

3690 IFFH>5GOTO3670 

3700 CLS 

3710 PRINT"HEAT LOSS APPROXIMATION, SHELL METHOD :": PRINT 

3720 L1=WA»F1(WR) 

3730 PRINT'LOSS THRU WINDOWS"; TAB (30) ;L1; " WATTS" 

3740 L2=DD*140 

3750 PRINT'LOSS THRU DOORS", -TAB(30) ;L2; " WATTS" 

3760 L3=((PP*CH)-WA-(DD*20))*F3(WF) 

3770 PRINT"LOSS THRU WALLS", -TAB (30) ;L3; " WATTS" 

3780 L4=AA*F4(CF) 

3790 PRINT"LOSS THRU CEILING" ;TAB(30) ;L4; " WATTS" 

3800 IFS=2GOTO3840 

3810 L5=PP*P5(FG) 

3820 PRINT"LOSS THRU SLAB";TAB(30) ;L5; " WATTS" 

3830 GOTO3860 

3840 L5=AA*F5(FP) 

3850 PRINT"LOSS THRU FLOOR" ,-TAB(30) ;L5 ; " WATTS" 

3860 L6=AA*CH*F6(FH) 

3870 PRINT"LOSS BY INFILTRATION";TAB(30) ,-L6; " WATTS" 

3880 L7=F*F7(DP) 

3890 PRINT"FIREPLACE HEAT LOSS" ;TAB(30) ;L7 ; " WATTS" 

3900 TW=L1+L2+L3+L4+L5+L6+L7 

3910 PRINT"TOTAL HEAT LOSS FOR HOUSE"; TAB(30);TW;" WATTS" 

3920 PRINT"ADJUSTED FOR OUTSIDE DESIGN TEMPERATURE: ";TAB(44) ;TW*DM; " WATTS" 

3930 PRINT" ( ";TW*DM*3.413;" B.T.U.'S )" 

3940 KW=(TW*DM*DG*C)/(1000»TD) 

3950 PRINT'ESTIMATED CONSUMPTION IS ";KW;" KW HOURS PER YEAR." 

3960 PRINT :PRINT"DO YOU WISH A COST ESTIMATE?" 

3970 INPUT"IF YES, ENTER '1'. IF NO, ENTER '2'.";M 

3980 CLS 

3990 IFM=2GOTO3270 

4000 INPUT"ENTER UTILITY RATE (I.E. FOUR CENTS PER KW HOUR - .04)";PX 

4010 RB=KW*PX 
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4020 RC=FIX(RB) 

4030 PRINT:PRINT"THE ESTIMATED ANNUAL COST OF OPERATION IS: $ 

4040 PRINT:PRINT:GOTO3270 

4050 PRINT: PRINT'WHICH CLASS OF WALL INSULATION IN THIS HOUSE?" 

4060 PRINT: PRINT"].- SHEATHING, SHEETROCK, NO INSULATION" 

4070 PRINT"2- R7 INSULATION" 

4080 PRINT"3- SHEATHING, SHEETROCK, R13 INSULATION" 

4090 PRINT"4- SHEATHING, SHEETROCK, R19 INSULATION" 

4100 PRINT: INPUT"ENTER CLASS NUMBER" ;ZB 

4110 IFZB>4GOTO4050 

4120 RETURN 

4130 END 

4140 CLS 

4150 PRINT"DOES THE FIREPLACE HAVE:" 

4160 PRINT:PRINT"1- NO DAMPER AT ALL" 

4170 PRINT"2- A POOR (LOOSE-FITTING) DAMPER" 

4180 PRINT"3- A GOOD (SNUG) DAMPER" 

4190 PRINT: INPUT'ENTER '1', '2', OR '3"";Q(A) 

4200 L7(A)=F7(Q(A1) 

4210 L7=L7+L7(A) 

4220 RETURN 



ENEBGY CONSUMPTION PROGRAM: by Steve Rumble 



This program is based on a five 
year utility study. It is designed 
to keep track of energy consump- 
tion data over a five year period 
in an effort to detect trends in 
energy costs. It will graph data, 
as well as visually display it. 
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1 CLS:PRINTCHRS(23) :PRINT8454 , "5 YEARS' UTILITIES STUDY" 

10 CLEAR550:DEFINTC,X,P:DEFSTRD:DIMA(4,12,6) ,P(12,6) :ONERRORGOTO20000 

15 C=193:FORX2=1TO12:C=C+64:FORX3=1TO6:P(X2,X3)=X3*8+C:NEXTX3,X2:GOSUBU000 

16 GOSUB12000:GOSUB12005 

20 D=INKEYS:IFNOT(D>"0"ANDD<"7")THEN20 

31 IFNOT(D="l"ORD="2"ORD="6")THEN35 

32 GOSUB12000:GOSUB13000:IFD1="N"THEN16 

35 ONVAL(D)GOSUB999, 2000, 3000, 5000, 5998, 7000 
40 CLS:Q=l:GOT016 

999 IFQ=1GOSUB11000 

1000 GOSUB12000:PRINT"DO YOU WANT TO VIEW THE DATA AS IT IS BEING READ?" : PRINT" I 
T TAKES A BIT LONGER, BUT BAD DATA CAN BE DETECTED. (Y/N)"; 

1001 D0=INKEY$:IFNOT(D0="Y"ORD0="N")THEN1001ELSEGOSUB12000 

1002 PRINT"PREPARE CASSETTE FOR READING ('PLAY') . . . " : PRINT'HIT 'ENTER' WHEN REA 
DY"; 

1003 D1=INKEY$:IFNOT(D1=CHRS(13))THEN1003ELSEGOSUB12000 

1004 PRINT"DATA BEING READ ..."; 

1005 INPUT#-1,D:BY$=LEFT$(D,4) :GOTO1015 

1010 INPUTt-l,D:IFLEN(D)=4THENRETURNELSEIFNOTLEN(D)=221THEN1030 
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1015 ? Y ^ T ?i D ; 4):C=VAL<MID?ID ' 5 ' 1 " :X1=VAL ( m '- v AI-{BY$):P=l:PORX2=CTOC+5--PORX 

1025 D="":GOTO1010 

1030 CLS:PRINTSTRINGS(64,"#"):PRINT@128,"I HAVE DETECTED AN ERROR ON YOUR DATA T 
APE. BE SURE THAT YOU" = PRINT:PRINT"ALWAYS POSITION YOUR DATA TAPE AT THE B 
EGINNING BEFORE ATTEMPT-" : PRINT: PRINTING TO 'READ- IT" 

1035 PRINTS403,"IF YOU FEEL THAT YOU HAVE ALREADY 'READ' SOME" : PRINT"VALID DATA 
AND WOULD LIKE TO TRY TO SALVAGE IT, THEN PRESS • 1 •" -PRINT- PRINT "TO RETUM 

,„-„ T ° ™f HENU (THEN DISPLAY THE DATA USING OPTION 13) . " s PRINT- PRINT 

1040 PRINT"OTHERWISE PRESS '0' TO RE-START THE PROGRAM " •" UNT - PRINT 

lltl rnJ,m 1 E ^n» F ™r^f " ORD= " 1 " )THEN1045ELSEIFD= " a " THENR ™ ELSE «'ETURN 

TENTER' W S RE™?~r E Y0UR CMSETTE F0R WRITING CMC08D-) ..." = PRINT"HI 

2010 D=INKEY?:IFNOTD=CHR?(i3)THEN2010 

700o GOSUB12a0B:P RlNT"DATA BEING WRITTEN . . . " ; 

=4ELlElSg^Sf0 F ° RX2=1TO12:FOR "=l™6:T=T + A(Xl,X2,X3)= N BXTX3,X2=IFT=0THENXl 

2025 NEXTX1 : PRINTJ-1 , "STOP " : RETURN 

2030 FORC=lT07STEP6:D(7)="":FORX2=CTOC+5:FORX3=lT06 

2040 D(8)=D(1)+D(2)+D(3)+D(4)+D(5)+D(6):D(7)=D(7)+D(8):NEXTX2 

2045 D=RIGHTS|STR5(VAL(BYS) + X1),LEN(STRS(VAL(BYS) + X1))-1)+RIGHTS(STRS(C),LEN(STR 

2050 PRINT»-1,D:D="":NEXTC:RETURN 

2100 D(X3)="00000"+D(X3) :RETURN 

2200 D(X3)="0000"+D(X3) :RETURN 

2300 D(X3)="000"+D(X3) jRETURN 

2400 D(X3)="00"+D{X3):RETURN 

2500 D(X3)="0"+D(X3) :RETURN 

2600 RETURN 

3000 IFQ=1GOSUB11000 

3001 GOSUB12000:IFNOT(BY$="")THEN3045 

3005 PRINT"WHAT IS THE FIRST YEAR FOR WHICH YOU HAVE DATA? (4 DIGITS) ",: PRINT86 

3010 FORxilT04 

3020 NEXT =INKEY?:IrNOT(D(X)>== " 0nANDD(X)< = " 9 " ) ™ EN3015ELSEPRIN ' rD(X); 

3030 BY$=D(1)+D(2) + D(3)+D<4):GOSUB12000:PRINT"CONFIRM YOUR BASE YEAR AS ",-BYS ; ". 

3035 D=INKEY$:IFNOT(D="Y"ORD="N")THEN3035ELSEIFD="Y"THEN3040 
3037 BY?="":GOTO3001 
3040 DY$=BY$:GOTO3075 

3050 F0RX-1T EAH T ° BE ADDED ' CHANGED OR WSPLAYED?";:PRINTe40,""; 

3060 NEXT =INKEY?:IPNOT(D(X>>= " " ANDD(X1<= " 9 " ) ™ EN3055ELSEPRINTD(X); 

3065 DY=D(l)+D(2)+D(3)+D(4):IFVAL(DY)-VAL(BYS)>=0ANDVAi;(DY)-VAL(BYS)< = 4THFN^fl7-; 

3070 GOSUB12000:PRINT"YEAR MUST BE BETWEEN "-BY?;" AND " -CHRS (24) -VAlTbSS^™ 

„„„ S ' 24 >'"' INCWSIVE.":FORX=0TO3999:NEXT:GOSUB120M:G6?O3045 ' $> ' " R 

3075 GOSUB12000:GOSUB14000 

3076 PRINT"1 = ADD/CHANGE DATA FOR ";DY,-". 2 = ADD/CHANGE OR DISPLAY" -PRINT"! 

= RETURN TO MENU. ";: PRINM101 , "DATA FOR ANOTHER YEAR "- M&PLAY - PRINT 3 
3080 D=INKEY?:IFNOT(D>"0"ANDD<"4")THEN3080ELSEIFD="1"THEN3090ELSEIFD="3"THENRETU 
3085 GOSUB11000:GOTO3045 

3090 S^«n» 

3095 F0RX=1T03 ' ' 

3100 D(X)=INKEY$:IFNOT((D(X)>="0"ANDD(X)<="9")ORD(X)=CHRS(13))THEN3100 
3105 IFD{X)=CHRS(13)THEN3115ELSEPRINTD(X); JTHEN3100 

3110 NEXT 

3120 X2=VAL(D{l)+D,21+D|3)):IPNOT<X2>0ANDX2<13 > THENG °SUB3500ELSE3125 

3125 P=32 : PRINTS24 , "COLUMN: " ; : PRINT889 , " ( 1-6) " ; : PRINTBP, " " • 
3130 F0RX=1T02 ni»n.r, , 

3135 D(X)=INKEYS:IFNOT((D(X)>="0"ANDD(X)<="9")ORD(X)=CHR$(13))THEN3135 
3140 IFD(X)=CHR$(13)THEN3150ELSEPRINTD(X); THEN3135 

3145 NEXT 

3150 X3=VAL(D(1)+D(2)):IFNOT(X3>0ANDX3<7)THENGOSUB3500ELSE3160 
3155 GOTO3130 

3160 IFINT(X3/2)=X3/2THEND="9"ELSED="." 

3170 P=47:PRINT@39, "AMOUNT: ";:PRINTei01," (0-999"; iD: "99)"- -PRTNTBP "». 

3175 F0RX=1T07 , -ff-iNiwe, , 

3180 D(X)=INKEYS:IFNOT((D(X)>="0"ANDD(X)<="9")ORD(X)="."ORD(X)=CHRS(13)ITHFN11Rn 
3185 IFD(X)=CHR$(13)THEN3195ELSEPRINTD(X); CHR? ( 13) ) THEN3180 

3190 NEXT 

3195 ^:I A J;'S4 ) i ,:>(2)+D{3,+D(4,+D(5>+D(6>+D ( 7 )> !lF ' r> 999999THENGOSUB3500ELSEIFT>=l 

000ANDD="."THENGOSUB3500ELSE3205 
3200 GOT03175 

3205 A(X1,X2,X3)=T:PRINT8P(X2,X3),"",-:IFD="."THENPRINTUSING"»## #S"-Am x? yt\ . 

ELSEPRINTUSING"#####»»;A(X1,X2,X3); " * . A(X1 ,X2 ,X3) ; 

3210 GOSUB12000:GOTO3076 
3500 FORC=0TO5:PRINT@P,"OUT OF RANGE"; : FORX=0TO199:NEXT-PRINTep " 

FORX=0TO199:NEXTX,C:PRINT8P,"",:RETURN """n.*, 

5000 IFBYS=""THENGOSUB12000ELSE5010 
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5005 PRINT'YOU HAVEN'T GIVEN ME ANY DATA TO WORK WITH YET! " :FORX=0TO4999 :NEXT:RE 

TURN 
5010 X0=VAL(BY$) :CLS:PRINT822,"S TATISTIC S" :PRINT:PRINT:PRINT"1 = STATS 

FOR ONE MONTH" : PRINT: PRINT"2 = STATS FOR A PERIOD OF SEVERAL MONTHS" : PRINT: 

PRINT"3 = COMPARE STATS FOR ONE MONTH TO STATS FOR ANOTHER MONTH": PRINT 
5015 PRINT"4 = COMPARE STATS FOR A PERIOD OF SEVERAL MONTHS TO" 'STRINGS (25 , " "); 

"STATS FOR A PERIOD OF ONE MONTH" :PRINT 
5020 PRINT"5 = COMPARE STATS FOR A PERIOD OF SEVERAL MONTHS TO" ; STRING? (25 , " "); 

"STATS FOR ANOTHER PERIOD OF SEVERAL MONTHS" :PRINT: PRINT"6 = RETURN TO MENU 

5025 D=INKEYS:IFNOT(D>"0"ANDD<"7")THEN5025 

5030 ONVAL(D)GOTO5100, 5200, 5300, 5400, 5500, 5600 

5100 CLS:PRINT@22, "STATISTICS FOR ONE MONTH" :PRINT:GOSUB5760 

5105 INPUT"DATE (MONTH, YEAR) ";X2(1) , XI (1) 

5110 FORX=2TO4:X2(X)=-99:NEXT:X1(1)=OU(1)-X0:GOSUB5850:IFES=5GOSUB5605ELSE5120 

5115 GOTO5100 

5120 GOSUB5700:GOSUB5800:X1=X1(1) :X2=X2(1) :F0RX3=1T06:TL(X3) =A(X1,X2,X3) :AL(X3)= 

TL(X3) :NEXT:FORX=2T06STEP2:UL(X)=TL(X-l)/TL(X) :NEXT:TL(7) =TL(1) +TL(3)+TL(5) 

:AL(7)=TL(7) :GOTO5900 
5200 CLS:PRINT"STATISTICS FOR A PERIOD OF SEVERAL MONTHS (DATE tl THRU DATE #2)" 

:GOSUB5760:FORX=1TO2:PRINT"DATE f ";X; " (MONTH, YEAR) ";: INPUTX21X) ,X1(X) :PRIN 

T:NEXT:X2(3)=-99:X2(4)=-99:X1(1)=X1(1)-X0:X1(2)=X1(2)-X0:GOSUB5850 
5205 IFES=5THENGOSUB5605ELSE5215 
5210 GOTO5200 

5215 GOSUB5700:GOSUB5800:GOSUB5750:GOTO5900 
5300 CLS:PRINT"COMPARE STATISTICS FOR ONE MONTH TO STATISTICS FOR ANOTHER MONTH" 

:PRINT888,"(DATE #1 TO DATE #3) " :PRINT:GOSUB5760:FORX=1TO3STEP2:PRINT"DATE 
#";X; "(MONTH, YEAR) " ; : INPUTX2 (X) ,X1(X) : PRINT: NEXT: X2 (2) =-99 :X2 (4) =-99 :X1 (1) 

=X1(1)-X0:X1(3)=X1(3)-X0 
5305 IFES=5THENGOSUB5605ELSE5315 
5310 GOTO5300 
5315 GOSUB5700:GOSUB5800:X1=X1(1):X2=X2(1):FORX3=1TO6:TL(X3)=A(X1,X2,X3):AL(X3)= 

TL1X3) :NEXT:FORX=2T06STEP2:UL(X)=TL(X-l)/TL(X):NEXT:TL(7)=TL(l)+TL(3)+TL(5) 

:AL(7)=TL(7) 
5320 X1=X1(3) :X2=X2(3) :F0RX3=1T06 :TR(X3) =A(X1,X2,X3) :AR(X3) =TR(X3) :NEXT:FORX=2TO 

6STEP2:UR(X)=TR(X-1)/TR(X) :NEXT:TR(7) =TR(1) +TR(3) +TR (5) :AR(7)=TR(7) :GOTO590 


5400 CLS:PRINT"COMPARE STATISTICS FOR A PERIOD OF SEVERAL MONTHS TO STATISTICS": 

PRINT864,"FOR A PERIOD OF ONE MONTH (DATE #1 THRU DATE #2) TO (DATE #3)": 

PRINT:GOSUB5760:FORX=1TO3:PRINT"DATE #";X; " (MONTH, YEAR) "; : INPUTX2 (X) ,X1(X) 

:PRINT:NEXT 
5405 X2(4)=-99:FORX=1TO3:X1(X)=X1(X)-X0:NEXT:GOSUB5850:IFES=5THENGOSUB5605ELSE54 

15 
5410 GOTO540 
5415 GOSUB5700:GOSUB5800:GOSUB5750:X1=X1(3) :X2=X2(3) :F0RX3=1T06:TR(X3) =A(X1,X2,X 

3) :AR(X3)=TR(X3) :NEXT:FORX=2T06STEP2:UR(X) =TR(X-1)/TR(X) :NEXT:TR (7 ) =TRU> +T 

R(3)+TR(5):AR(7)=TR(7) :GOTO5900 
5500 CLS:PRINT65, "COMPARE STATISTICS FOR A PERIOD OF SEVERAL MONTHS TO":PRINTS71 

, "STATISTICS FOR ANOTHER PERIOD OF SEVERAL MONTHS" :PRINT8135 ," (DATE #1 THRU 
DATE »2) TO (DATE #3 THRU DATE *4) " : PRINT:GOSUB5760 
5505 F0RX=1T04:PRINT"DATE #" ;X; " (MONTH, YEAR) ";: INPUTX2 (X) , XI (X) : PRINT: NEXT: FORX 

=1TO4:X1(X)=X1(X)-X0:NEXT:GOSUB5850:IFES=5THENGOSUB5605ELSE5515 
5510 GOTO5500 

5515 GOSUB5700:GOSUB5800:GOSUB5750:IFX1(3)=X1(4)THEN5525 
5520 FORX2=X2(3)T012:FORX=1T06:TR(X)=TR(X)+A(X1(3) ,X2,X) :NEXTX,X2:F0RX1=X1 (3) +1T 

OX1(4)-1:FORX2=1T012:FORX=1T06:TR(X)=TR(X)+A(X1,X2,X) :NEXTX,X2,X1:FORX2=1TO 

X2(4) :F0RX=1T06:TR(X)=TR(X)+A(X1(4),X2,X) :NEXTX,X2:GOTO5530 
5525 FORX2=X2(3)TOX2(4) :F0RX=1T06 :TR(X) =TR(X) +A(X1 (3) ,X2,X) :NEXTX,X2 
5530 C=13-X2(3)+12*(X1(4)-X1(3)-1)+X2(4):TR(7)=TR(1)+TR(3)+TR(5):F0RX=1T07:AR(X) 

=TR(X)/C:NEXT:FORX=2T06STEP2:UR(X)=TR(X-l)/TR(X) :NEXT:GOTO5900 
5600 RETURN 

5605 CLS:PRINTSTRINGS(25, "<");" ERROR ";STRINGS(25,">") : PRINT 
5610 PRINT"YOU HAVE MADE AN ERROR IN ENTERING YOUR MONTHS AND YEARS DUE TO":PRIN 

T"ANY COMBINATION OF THE FOLLOWING REASONS: " :PRINT: PRINT 
5615 PRINT'l. MONTH NOT BETWEEN 1 AND 12" :PRINT:PRINT"2 . YEAR NOT BETWEEN" ;X0; 

"AMD", -X0+4: PRINT :PRINT"3. DATE »2 NOT GREATER THAN DATE SI AND/OR" i STRINGS 

(25," ");"DATE «4 NOT GREATER THAN DATE #3" 
5620 PRINT:PRINT:PRINT"BE CAREFULII ";TAB(40) "HIT 'ENTER' TO CONTINUE"; 
5625 ES=MKEYS:IFNOT(ES=CHRS(13))THEN5625ELSERETURN 
5700 F0RX=1T04:F0RC=1T0X2(X) :READDM(X) : NEXT: RESTORE: NEXT: RETURN 
5750 IFX1(1)=X1(2)THEN5754 
5752 F0RX2=X2(1)T012:F0RX=1T06:TL(X)=TL(X)+A(X1(1),X2,X) :NEXTX,X2:F0RX1=X1 (1) +1T 

0X1(2)-1:F0RX2=1T012:F0RX=1T06:TL(X)=TL(X)+A(X1,X2,X) :NEXTX,X2,X1:FORX2=1TO 

X2(2):F0RX=1T06:TL(X)=TL(X)+A(X1(2),X2,X) :NEXTX,X2:GOT05756 
5754 FORX2=X2(l)TOX2(2):FORX=lT06:TL(X)=TL(X)+A(Xl(l),X2,X):NEXTX,X2 
5756 C=13-X2(1)+12*(X1(2)-X1(1)-1)+X2(2):TL(7)=TL(1)+TL(3)+TL(5):F0RX=1T07:AL(X) 

=TL(X)/C:NEXT:FORX=2T06STEP2:UL(X)=TL(X-l)/TL(X) :NEXT:RETURN 
5760 PRINT" 'ENTER'", "NOTE: USE COMMA TO SEPARATE MONTH AND YEAR" : PRINT: RETURN 
5800 CLS:PRINTCHRS(23):PRINT6454,"I AM ACCUMULATING DATA" :F0RX=1T06 :TL(X) =0:UL(X 

)=0:TR(X)=0:UR(X)=0:NEXT: RETURN 
5850 ES=0:FORX=1TO4:IFX2(X)=-99THEN5865 
5855 IFX2(X)<10RX2(X)>12THEN5897 
5860 IFX1(X)<0ORX1(X)>4THEN5897 
5865 NEXT 

5870 IFD="l"ORD="3"THEN5898 
5875 IFX1(2)<X1(1)THEN5897 
5880 IFX1(2)=X1(1)ANDX2(2X=X2(1)THEN5B97 
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5885 IFNOTD="5"THEN5898 

5898 IFX1(4)<X1(3)THEN5897 

5895 IFX1(4)=X1(3)ANDX2(4X=X2(3)THEN5897ELSE5898 

5897 ES=5 

5898 RETURN 

5900 A$="T0TAL AVERAGE UNIT COST" :B5="AMOUNT AMOUNT IN CENTS" :CS="AVG $$ PER M 
0:":B$="TOTAL $$: " :CLS:F0RX=1T04:X1 (X) =X1{X) +X0:NEXT 

5901 PRINTei0,DM(l);",";Xl(l);:IFD="2"ORD="4"ORD="5"THENPRINT820,"THRU";ELSE5903 

5902 PRINT825,DM(2);",";X1(2); 

5903 IFD>"2"PRINT839,DM(3);",";X1(3) 

5904 IFD="5"PRINT849,"THRU";" ";DM{4) ; ", " ;X1(4) ; 

5905 PRINT875,A$;:IFD>"2"PRINT8104,A$; 
5910 PRINT8138,B$;:IFD>"2"PRINT8167,B$; 

5915 PRINT8192,"GASS$":PRINT8256,"C C F" :PRINT8384,"H20$$" :PRINT8448, "G A L":PRI 

NT8576,"PWRS$":PRINT8640,"K W H" : PRINT8778,C$; : IFD>"2"PRINT8807 ,C$; 
5920 PRINT8847,E$;:IFVAL(D)>2PRINT8876,E$; 
5925 C=1:FORX=200TO584STEP192:PRINT8X,"";:PRINTUSING"##I»#.##";TL(C);:PRINT8X+10 

,"";:PRINTUSING"###.«»";AL(C);:C=C+2:NEXT 
5930 C=2:FORX=264TO648STEP192:PRINT8X,*";:PRINTUSING"#»lt*lt#";TL(C);:PRINTex+10 

, "";:PRINTUSING"l#f#l*";AL(C) ; : PRINT8X+19 ,"";: PRINTUSING"## .*#!»" ;UL (C) *100 

I :C=C+2 :NEXT 
5935 PRINT87 93, ""; : PRINTUSING" If tttl.ll* 

«»";TL(7);:IFD<"3"THEN5990 
5940 C=l:FORX=229T0613STEP192:PRINT8X, 



AL<7) ;:PRINT8857,"";:PRINTUSING"#t##»l. 
: PRINTUSING" HI I » . It " ;TR(C) ; : PRINT8X+10 



;: PRINTUSING" tit . tt";AR(C) ;:C=C+2:NEXT 
5945 C=2:FORX=293T0677STEP192:PRINT8X,""!:PRINTUSING"fttttttt";TR(C) ;:PRINT8X+10 

,"";: PRINTUSING"! t tit t";AR(C) ; : PRINT8X+19 ,"" ; : PRINTUSING" ##. till" ;UR(C) *100 

8 : 0=0+2 : NEXT 
5950 PRINT882'2,"";:PRINTUSING"tttttt.tt";AR(7) ; : PRINT8886, "" ; :PRINTUSING"tttti t . 

I#";TR(7) ; 

5990 PRINT8960,"MORE STATISTICS? (Y/N)"; 

5991 D=INKEYS:IFNOT(D="Y"ORD="N")THEN5991ELSEIFD="Y"THEN5000ELSERETURN 
5995 DATAJAN, FEB, MAR, APR, MAY, JUN, JUL, AUG, SEP, OCT, NOV, DEC 

5998 IFBYS=""THENGOSUB12000ELSE6000 

5999 GOTO5005 

6000 CLS:D(1)="GAS DOLLARS" :D( 2) ="GAS CCF 'S" :D(3) ="WATER DOLLARS" :D( 4) ="GALLONS" 
:D(5)="ELECTRICITY DOLLARS" :D(6 ) ="KILOWATT HOURS" :D(7 ) ="TOTAL DOLLARS" 

6001 PRINT826,"G R A P H S" :PRINT:PRINT: PRINT'l = " ;D(1) :PRINT: PRINT"2 = ";D(2): 
PRINT:PRINT"3 = " ;D(3) : PRINT: PRINT"4 = ";D(4) : PRINT: PRINT"5 = ";D(5):PRINT 
:PRINT"6 = ";D(6) :PRINT:PRINT"7 = ";D(7); 

6005 D=INKEY$:IFNOT(D>"0"ANDD<"8")THEN6005ELSEX3=VAL(D) 

6010 F1=1/6:F2=.5:F3=5/6:C4=64:CLS:HV=0:IFX3=7THEN6013 

6011 FORX1=0TO4:FORX2=1TO12:IFA(X1,X2,X3)>HVTHENHV=A(X1,X2,X3) 

6012 NEXTX2,X1:GOTO6015 

6013 FORX1=0TO4:FORX2=1TO12:HT=A(X1,X2,1)+A(X1,X2,3)+A(X1,X2,5) : IFUT>HVTHENIIV=IIT 

6014 NEXTX2,X1 

6015 D="JFMAMJJAS0ND":P=16196:F0RC=1T05:F0RX=1T012:P0KEP,ASC(MID$(D,X,1)) :P=P+1: 
NEXTX,C:FORX=0TO4:PRINT8899+(X*12) ,VAL(BY$) +X; :NEXT:E=10 

6016 IFHV/E<10THEN6020ELSEE=E*10 

6017 GOTO6016 

6020 R=E/10:SC=(INT(HV/E+1))*R:FORX=1TO10:P1(X)=VAL(MIDS(STRS(SC),2,1))*X:NEXT:P 
RINT876 9 , "0" ; : C=766 : FORX=1TO10 : PRINT8C- (X*64) , "" ; : PRINTP1 (X) i : PRINT8C- (X*64 
)+6,STRING$(60,"-");:NEXT:GOSUB6100:PRINT865, "VERTICAL SCALE IS 1";R;:P0KE1 
5444,58:PRINT828,D(X3) ; 

6023 P=16132:IFX3=7THEN6025 

6024 FORX1=0TO4:FORX2=1TO12:X=INT(A(X1,X2,X3)/SC) :R=A(X1,X2,X3)/SC-X:GOTO6026 

6025 FORX1=0TO4:FORX2=1TO12:HT=A(X1,X2,1)+A(X1,X2,3)+A(X1,X2,5) :X=INT (HT/SC) :R=H 
T/SC~X 

6026 IFX<2THEN6033 

6027 POKEP,130:FORC=1TOX-1:POKEP-(C4*C) ,170:NEXT 

6028 IFR<F1THEN60 32ELSEIFR<F2THEN6031ELSEIFR<F3THEN6030 

6029 P0KEP-(C4*C) ,170 :P0KEP-(C4*(C+1! ) ,168:GOTO6065 

6030 P0KEP-(C4*C) ,170:POKEP-(C4*(C+1) ) ,160 :GOTO6065 

6031 P0KEP-(C4*C) ,170:GOTO6065 

6032 P0KEP-(C4*C) ,168:GOTO6065 

6033 IFX=0THEN6039ELSEPOKEP,130 

6034 IFR<F1THEN603 8ELSEIFR<F2THEN6037ELSEIFR<F3THEN6036 

6035 POKEP-64,17 0:POKEP-128,16 8:GOTO6065 

6036 POKEP-64,17 0:POKEP-128,160:GOTO6065 

6037 POKEP-64,170:GOTO6065 

6038 POKEP-64,168:GOTO6065 

6039 IFR<F1THEN6065ELSEIFR<F2THEN6042ELSEIFR<F3THEN6041 

6040 POKEP,130:POKEP-64,16 8:GOTO606 5 

6041 POKEP,130:POKEP-64,160:GOTO606 5 

6042 POKEP,130:GOTO6065 
6065 P=P+1:NEXTX2,X1 

6070 PRINT8960,"MORE GRAPHS (Y/N)"; 

607 5 D=INKEYS:IFNOT(D="Y"ORD="N")THEN6075ELSEIFD="Y"THEN6000ELSERETURN 

6100 IFMID$(STR$(HV) ,2,1)="9"R=E 

6105 RETURN 

7000 CLS : PRINTCHR5(23) : PRINT8452, "THIS SESSION IS TERMINATED" : FORX=0TO1999 

: NEXT :CLS: END 
11000 CLS:PRINT8140,"1 2 3 4 5 6" 
11005 PRINT8198,"MO GAS$$ CCF H20SS GAL PWRS5 K W R" 
11010 C=198:FORX=1T012:C=C+64:PRINT8C,"";: PRINTUSING" tt";X;:NEXT:PRINTCHR$ (28) ;: 

RETURN 
12000 PRINTCHR$(28) ; : PRINTSTRINGS (128 , " "); : PRINTCHR$ (28) ; : RETURN 
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12005 
12010 
12015 
13000 
13005 
13010 
14000 
14005 



15572 
20000 



PRINT"MEHU: (l)READ DATA (3)ADD / CHANGE (4JSTATISTICS (G)END" 

PRINTTAB(7)"(2)WRITE DATA OR DISPLAY DATA (51GRAPH"; 

POKE15381,191:POKE15399,191:POKE15445,143:FOKE15463,143:RETURN 

IFD="1"THENA$="READ"ELSEIFD="2"THENA$="WRITE"ELSEA$="END" 

PRINT'VERIFY YOUR CHOICE: Y = ";A$ : PRINTTAB(21) "N = RETURN TO MENU"; 

D1=INKEYS:IFNOT(D1="Y"ORD1="N")THEN13010BLSERETURN 

F0RX=1T04:P0KEX*128+15618,ASC(MID$(DY,X,1)) :NEXT:X1=VAL(DY) -VAL(BY$) 

F0RX2=lTO12:FORX3=lTO5STEP2:PRINT@P(X2,X3),"";:PRINTUSING"tf».#»";A(Xl,X2, 

X3);:NEXT:FORX3=2T06STEP2:PRINT6P(X2,X3),"" j :PRINTUSING" t«fM#" |A(X1,X2,X3) 

; : NEXTX3 ,X2 : PRINTCHRS ( 28 ) ; : RETURN 
-MEM 
IFERL>=1005ANDERL< = 1015THENRESUME1030ELSEIFERR/2+l=HTHENRESUMENEXTELSERES 

UME5605 



INSULATION CALCULATIONS: 

by Innovative Design Consultants, Inc. 



Are you facing another winter 
heating season in a cold climate? 
If so, then this program will be of 
use to you in determining the 
amount, type and cost effec- 
tiveness of the various insulating 
materials available for use in 
home applications. A seven year 
payback period is used as a 
baseline for ten common insula- 
tion situations. Keyed to 
telephone area codes, this pro- 
gram may prove the most prac- 
tical you've ever used. 



CMttKiEStriiauTiwisff' : 

I CSIL1NGS Ml ATTIC USUI!* 

j naufiic attic wis 

3 INSUWIW EXiaiUi IKK WIS (UCOD t Hltt SINK) 
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5. IHSTDLLUB STH8I HOOK 

6. INSULATING FLOORS MS fflfTD «U. SPACES 

?. insuuting wis cf 'uMHia am. spaces 

8. INSULATING DUCTS IN WMD CML SPACES 

S. INSULATING WIS Cf BASEKKTS 

16. INSULATING- HCTS lit «SOtKTS - 

MB TIC CSTEGOSf NLtKS FOP OOSt CftflUTKH? . 



10 1 


ILS: CLEAR 100 








20 ] 


PRINT§453,CHR$(23); 


"INSULATION 


CALCULATION' 


100 


DEFINT A-Y 








110 


DIM A(20,ll) 'AREA 


CODE (STATE, 


.NUMBER) 


120 


DIM N(20) '# OF AREA CODES 


BY 


STATE 


130 


DIM E(21,10) 'ENERGY (STATE, 


.CATEGORY) 


140 


DIM P1(22),P2(22) 


' PAYBACK 


PER CATEGORY 


145 


DIM T$(25),P$(24) 


'DISPLAY 


PHRASES 


150 


FOR X=l TO 20 








160 


READ N(X) 








170 


NEXT X 








180 


FOR X=l TO 20 








190 


FOR Y=l TO N(X) 








200 


READ A(X,Y) 








210 


NEXT Y 








220 


NEXT X 








230 


FOR X=l TO 21 








240 


FOR Y=l TO 10 








250 


READ E(X,Y) 
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26 NEXT Y 

270 NEXT X 

280 FOR X=l TO 22 

290 READ PKX) ,P2(X) 

300 NEXT X 

302 FOR X=l TO 24 

304 READ P$(X) 

306 NEXT X 

310 DATA 11,7,7,10,7,3,7,2,7,3 

320 DATA 8,2,1,5,5,3,9,2,4,1 

325 REM NEW YORK 

330 DATA 203,401,914,212,201,609,215,717,814,412,516 

335 REM WASH D.C. 

340 DATA 301,302,202,304,703,804,606 

345 REM CLEVELAND 

350 DATA 216,614,513,419,219,317,812 

355 REM CHICAGO 

360 DATA 312,815,309,217,608,414,319,616,517,313 

365 REM ATLANTA 

370 DATA 919,704,615,404,803,912,205 

375 REM MIAMI 

380 DATA 813,305,904 

3 85 REM MEMPHIS 

390 DATA 901,601,501,502,618,314,417 

395 REM NEW ORL 

400 DATA 504,318 

405 REM MINNEAPOLIS 

410 DATA 715,507,612,218,701,605,906 

415 REM KANSAS CITY 

420 DATA 913,316,816 

425 REM DALLAS 

430 DATA 214,713,512,817,806,915,405,918 

435 REM DENVER 

440 DATA 303,307 

445 REM PHOENIX 

450 DATA 602 

455 REM SEATLE 

460 DATA 206,509,503,208,406 

465 REM SAN FRAN 

470 DATA 408,209,916,415,707 

475 REM L.A. 

480 DATA 714,213,805 

485 REM BOSTON 

490 DATA 413,603,207,802,518,315,607,716,617 

495 REM SALT LAKE 

500 DATA 702,801 

505 REM OMAHA 

510 DATA 515,717,308,402 

515 REM ALBEQO 

520 DATA 505 

530 DATA 4670,5600,4440,3980,3290,3290,3290,4440,3290,5600 

540 DATA 3410,4020,3260,2950,2490,2490,2490,3260,2490,4020 

550 DATA 2630,2980,2550,2380,2120,2120,2120,2550,2120,2980 

560 DATA 3170,3760,3020,2730,2290,2290,2290,3020,2290,3760 

570 DATA 2200,2870,2040,1710,1210,1210,1210,2040,1210,2870 

580 DATA 2410,3870,2050,1320,230,230,230,2050,230,3870 

590 DATA 2160,2770,2010,1700,1250,1250,1250,2010,1250,2770 

600 DATA 1850,2720,1630,1200,540,540,540,1630,540,2720 

610 DATA 3300,3300,3300,3300,3300,3300,3300,3300,3300,3300 

620 DATA 1920,2390,1800,1570,1220,1220,1220,1800,1220,2390 

630 DATA 2070,2850,1880,1490,910,910,910,1880,910,2850 

640 DATA 1610,1830,1550,1440,1280,1280,1280,1550,1280,1830 

650 DATA 2170,3210,1910,1400,620,620,620,1910,620,3210 

660 DATA 3480,3480,3480,3480,3480,3480,3480,3480,3480,3480 

670 DATA 1160,1160,1160,1160,1160,1160,1160,1160,1160,1160 

680 DATA 710,870,670,600,480,480,480,670,480,870 

690 DATA 4500,4860,4410,4230,3970,3970,3970,4410,3970,4860 

700 DATA 1980,2350,1880,1700,1420,1420,1420,1880,1420,2350 

710 DATA 2240,2560,2160,2010,1770,1770,1770,2160,1770,2560 

720 DATA 2240, 2680, 2120, 1900, 1570, 157B, 1570, 2120, 1570, 2680 

730 DATA 4410,5410,4260,3800,3100,3100,3100,4260,3100,5410 

740 REM 

750 DATA 310,500,390,630,1340,2150,1610,2580,2120,3400,1210,2420 

760 DATA 2240,4480,0,2960,1930,2890,3520,5270,3750,5360 

770 DATA 5380,8070,830,1330,2220,3560,1740,2790,4510,7220 

780 DATA 3030,6050,3580,7160,1730,2590,3860,5780,2200,4400 

790 DATA 2580,5160 

795 DATA "R-3 INSULATION", "R-ll INSULATION" , "R-19 INSULATION" 

800 DATA "R-30 INSULATION", "ONE INCH INSULATION" 

805 DATA "FOAM/BLOWN INSULATION" , "STORM WINDOWS" , "STORM DOORS" 

810 DATA "NO CEILING INSULATION" , "LESS THAN 3 INCHES" 

815 DATA "MORE THAN ONE INCH" , "UNINSULATED WALLS" 

820 DATA "SINGLE WINDOWS" , "DOUBLE WINDOWS" 

825 DATA "SINGLE DOORS W/ GLASS" , "DOUBLE WITHOUT GLASS" 

830 DATA "NO FLOOR INSULATION" , "NO WALL INSULATION" 

835 DATA "UNINSULATED DUCTS", "IF YOU HAVE:" 

840 DATA "AND YOU WANT TO ADD: ", "YOURSELF" , "CONTRACT" 
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2030 


PRINT" 


1. 


2040 


PRINT" 


2. 


2050 


PRINT" 


3. 


2060 


PRINT" 


4. 


207 


PRINT" 


5. 


20B0 


PRINT" 


6. 


2090 


PRINT" 


7. 


2100 


PRINT" 


8. 


2110 


PRINT" 


9. 


2120 


PRINT" 


10. 



845 DATA "TWO INCH INSULATION" 

850 CLS 

1000 PRINT"ENTER YOUR TELEPHONE AREA CODE" 

1010 INPUT A 

1020 X=l 

1030 Y-l 

1040 IP A=A(X,Y) THEN 1100 

1050 Y=Y+1:IF Y<=11 THEN 1040 

1060 X=X+1:IF X<=20 THEN 1030 

1070 PRINT"YOUR AREA CODE CAN ■ t BE FOUND!" 

1080 PRINT'PLEASE TRY ENTERING ANOTHER" 

1090 GOTO 1010 

1100 PRINT 

1110 PRINT A 

2000 CLS 

2010 PRINT TAB (20), -"CATEGORIES OF INSULATION USAGE" 

2020 PRINT 

CEILINGS AND ATTIC INSULATION" 

INSULATING ATTIC DUCTS" 

INSULATING EXTERIOR FRAME WALLS (WOOD & BRICK SIDING) " 

INSTALLING STORM WINDOWS OR TRIPLE GLASS" 

INSTALLING STORM DOORS" 

INSULATING FLOORS OVER VENTED CRAWL SPACES" 

INSULATING WALLS OF UNVENTED CRAWL SPACES" 

INSULATING DUCTS IN VENTED CRAWL SPACES" 

INSULATING WALLS OF BASEMENTS" 

INSULATING DUCTS IN BASEMENTS" 
2130 PRINT8832,CHR$(31); 

2200 PRINT8B32, "ENTER THE CATEGORY NUMBER FOR ENERGY CALCULATION"; 
2210 INPUT Z 

2220 IP Z<1 OR Z>10 THEN 2130 
2500 CLS 

2510 PRINT814,"FOR A PAYBACK PERIOD OF SEVEN YEARS:" 
2520 GOSUB 2730:T=7 

2530 ON Z GOTO 3000,3200,3300,3400,3500,3600,3700,3800,3900,4000 
2540 REM GRAPHICS SUBROUTINE 
2550 Y=4:LIN=128:PNT=1 
'2560 FOR 1 = 1 TO 127 'DRAW LINES 
2570 SET(I,Y) :SET(I,Y+6) 
2580 NEXT I 
2590 FOR I=Y TO Y+6 
2600 SET(0,I) :SET(1,I) :SET(45,I) 
2610 SET(89,I) :SET(109,I) :SET(126,I) :SET(127,I) 
2620 NEXT I 
2630 Y=Y+6 

2640 PRINT8(LIN+1),T$(PNT) ; 
2650 PRINTS (LIN+23) ,TS(PNT+1) ; 
2660 PRINTS (LIN+46) ,T$(PNT+2) ; 
2670 PRINTi(LIN+55),TS(PNT+3); 
2680 LIN=LIN+128:PNT=PNT+4 
2690 IF T$(PNT)<>""THEN 2560 
2700 RETURN 
2710 REM 

2720 REM HEADER SUBROUTINE 
2730 FOR 1=1 TO 4 
2740 T$(I)=PS(I+19) 
2750 NEXT I 
2755 RETURN 
27 60 REM 

277 REM PAYBACK CALCULATION 
2780 E=E(X,Z)-P1(C) 
2790 TS(T)=STR$(E) 
2800 E=E(X,Z)-P2(C) 
2810 TS(T+1)=STR5(E) 
2820 T=T+4:C=C+1 
2830 RETURN 
3000 REM CEILING 
3010 T$(5)=PS(9):T$(6)=P$(3) 
3020 C=1:T=7: GOSUB 27 80 
3040 T$(9)=P$(9) :T$(10)=PS(4) 
3050 GOSUB 27 80 

3060 T$(13)=PS(10) :TS(14)=PS(2) 
307 GOSUB 27 80 

3080 T$(17)=P$(10):T$(18)=P$(3) 
3090 GOSUB 27 80 

3100 T$(21)=P$(10):TS(22)=P$(4) 
3110 T$(25)="" 
3120 GOSUB2780:GOSUB2550 

3130 PRINT8960, "PRESS 'ENTER' TO CONTINUE"; 
3140 INPUT Z?:GOTO 2000 
3200 T$(5)=PS(5) :T$(6)=P$(5) 
3210 C=6:GOSUB 2780 
3220 T$(9)=P$(11) :T$(10)=P$(5) 
3230 GOSUB27 80 
3240 T$(13)="":GOSUB 2550 
3250 GOTO 3130 
3300 TS(5)=P$(12) :TS(6)=PS(6) 



163 



3310 C=8:G0SUB 2780 

3320 T$(9)="":G0SUB 25S0 

3330 GOTO3130 

3400 T$(5)=P$(13):T?(6)=P$(7) 

3410 C=9:G0SUB 2780 

3420 T$(9)=P$(14) :T$(10)=P$(7) 

3430 GOSUB 27 80 

3440 T$(13)="":GOSUB 2550 

3450 GOTO 3130 

3500 T$(5)=PS(15):TS(6)=P$(8) 

3510 C-ll: GOSUB 27 80 

3520 T$(9)=P$(16) :T$(10)=P${8) 

3530 GOSUB 27 80 

3540 T?(13)="":GOSUB 2550 

3550 GOTO3130 

3600 T$(5)=PS(17) :T$(6)=P$(2) 

3610 C=13:GOSUB 2780 

3620 T$(9)=P$(17) :T$(10)=PS(3) 

3630 GOSUB 27 80 

3640 T$(13)="":GOSUB 2550 

3650 GOTO3130 

3700 T$(5)=P?(18):TS(6)=PS<2) 

3710 C=15:GOSUB 2780 

3720 T$(9)=P$(18) :T$(10)=P$(3) 

3730 GOSUB 2780 

3740 T$(13)="":GOSUB 2550 

3750 GOTO 3130 

3800 T$(5)=PS(19):TS(6)=P$(5) 

3810 C=17:GOSUB2780 

3820 T$(9)=P$(19) :T$(10)=P$(24) 

3830 GOSUB 27 80 

3840 T$(13)="":GOSUB2550 

3850 GOTO 3130 

3900 T$(5)=P?(18):T$(6)=P5(1) 

3910 C=19: GOSUB 2780 

3920 T$(9)=P$(18).-T$(10)=PS<2) 

3930 GOSUB 27 80 

3940 T?(13)="":GOSUB 2550 

3950 GOTO 3130 

4000 T$(5)=P$(19):T$(6)=P$(5) 

4010 C=21: GOSUB 2780 

4020 T$(9)=PS(19) :T$(10)=P$(24) 

4030 GOSUB 27 80 

4040 T$(13)="":GOSUB 2550 

4050 GOTO 3130 
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MY MINI AND I 



Things To Do 

The Dummy Diet 

Grocery List 

Home Finance Program 

Trip Mileage 

Tax Shelter Analysis 

Phone Bill Program 

Stock Market Portfolio 

Pitching Analysis 

Flight Plan 



Richard Evans 
Joe Leonard 
Sherman Wantz 
Dan Booth 
James Morgan 
Oren McBride 
Walter McCahan 
A.S. Turner 
Jim Wells 
Jack Adams 



165 



THINGS TO DO: by D. Evans 



This program will transform 
your TRS-80 into a remindful 
mother. Program in your ap- 
pointments and errands for the 
coming week, then enjoy your 
morning coffee each day, along 
with a quick computer consult to 
outline the day's activities. Will 
prove most useful to the forgetful 
and to those who tend to pro- 
crastinate. 




1 CLS 

2 PRINTCHR$(23) 

3 PRINT:PRINT"EVANS/3" 

4 PRINT:PRINT:PRINT"THINGS TO DO LIST" 

5 FOR 1=1 TO 20BB:NEXT 

IB CLS:CLEAR 10BB:DIH A$(15]:DIM A(15) 
20 PRINT"THINGS TO DO LIST" 
30 PRINT"=================" 

4B PRINT: PRINT'ENTER UP TO 15 ITEMS. WHEN FINISHED ENTERING DATA" 
50 PBINT"ENTER 'END' TO TERMINATE THE ENTRY PROCESS." 

55 PRINT'DO NOT USE ' : • OR IT PLUS ANY DATA FOLLOWING IT" 

56 PRINT'WILL BE IGNORED." 
60 FOR A=l TO 15 

70 PRINT8511,A;" - ";:INPUT ASIA) 

80 IF A$(A)="END" THEN A=A-l:GOTO 100 

90 NEXT 

100 CLS: IF A=16 THEN A=15 

110 PRINT'YOU WILL BE SHOWN TWO ENTRIES AT A TIME." 

120 PRINT"DECIDE WHICH OF THE TWO HAS PRIORITY." 

130 PRINT: PRINT"BEFORE STARTING DECIDE ON YOUR ULTIMATE GOAL." 

140 PRINT"MAKE EACH DECISION FOR THE ONE WHICH BEST GETS" 

150 PRINT"YOU TOWARDS THAT GOAL. DO NOT DECIDE BASED ON" 

160 PRINT'WHAT YOU WOULD RATHER DOi" 

180 PRINT:PRINT"PRESS ENTER TO BEGIN:" 

190 PRINT:PRINT: INPUT A$ 

200 CLS 

210 FOR B=l TO A-l 

220 FOR C=B+1 TO A 

225 CLS 

230 PRINTM20,"1 - ";AS(B) 

240 PRINT@448,"2 - ";A$(C) 

250 PRINT@665,"";:INPUT D 

260 IF D<1 OR D>2 THEN 230 

270 IF D=l THEN A(B)=A(B)+1 

280 IF D=2 THEN A(C)=A(C)+1 

290 NEXT C 

300 NEXT B 

310 CLS 

320 PRINT"HERE'S YOUR LIST..." 

325 PRINT:PRINT:PRINT"MOST IMPORTANT IS LISTED FIRST - LEAST LAST. 

330 FOR 1=1 TO 1000:NEXT 

340 CLS 

350 FOR 1=1 TO A 

360 FOR X=l TO A 

370 IF AIXX16 THEN 390 

380 NEXT X 

390 H=X 

400 FOR X=H TO A 

4B5 IF A(X)=99 THEN 420 

410 IF A(X)>A(H) THEN H=X 

420 NEXT X 

430 PRINTI;" - ";AS(H1 

440 A(H)=99 

450 NEXT I 

460 PRINT@960,"";:INPUT"PRESS ENTER TO REVIEW AGAIN"jA$ 

470 FOR 1=1 TO 15 

480 A(I)=0 

490 NEXT I 

500 GOTO 100 
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THE DUMMY DIET: by J.M. Leonard, M.D. 



Shed those extra pounds by 
sticking to your TRS-80's sug- 
gested meal menus, totaling only 
1250 daily calories. If you don't 
find a particular suggestion ap- 
petizing, just request an alter- 
native. Written by an M.D. for 
people who need a little help 
with meal planning at diet time. 



•ii_ F SHtWaJH. JI«tTER)J«J,0R_«llin),HIIMO:„ 




1000 
1010 

1050 
1060 
1070 
1080 
1090 
1100 
1110 
1120 
1130 
1140 
1150 
1160 
1170 
1180 
1190 
1200 
1210 
1220 
1230 
1240 
12"0 
1260 
1270 
1280 
1290 
1300 
1310 
1320 
1330 

1340 
1350 
1360 
1370 
1380 
1390 
1400 

1410 
1420 
1430 
1440 
1450 
1460 
1470 
1480 
1490 
1500 
1510 
1520 
1530 
1540 
1550 
1560 
1570 



i ***************************** 

THE DUMMY DIET 
i ***************************** 

REM ** BASED ON APPROXIMATELY 1250 CALORIES PER DAY ** 
CLEAR 5000:DIM S$(90) 

CLS:PRINT:PRINT" THE DUMMY DIET" 

PRINT" ========================= " 

PRINT: PRINT 

PRINT" SELECT ONE : 

PRINT 

PRINT" 1.- INSTRUCTIONS 

PRINT" 2.- MEAL SELECTIONS 

PRINT" 3.- END PROGRAM 

AS=INKEY$:IF A$="" THEN 1160 

IF AS="3" THEN CLS : END 

IF AS="2" THEN 1450 

IF A$="l" THEN 1210 

GOTO 1160 

CLS : PRINT : PRINT : PRINT 

PRINT" THIS DIET MAKES SEVERAL ASSUMPTIONS:" 



YOU ARE OVERWEIGHT" 

YOU ARE WILLING TO FOLLOW EXACT INSTRUCTIONS" 

YOU ARE OTHERWISE HEALTHY (IF IN DOUBT," 

CHECK WITH YOUR DOCTOR FIRST) " 

YOU ARE NOT TOTALLY SEDENTARY, IE.," 

JUST SITTING OR LYING AROUND ALL DAY." 

ENTER TO CONTINUE 



ENOUGH (APPROX. 1250 CAL.) SO THAT SOMEO 
CAN LOSE SLOWLY, WHILE "; 



PRINT" 1. 

PRINT" 2. 

PRINT" 3. 

PRINT" 

PRINT" 4. 

PRINT" 

PRINT 

PRINT" 

A$=INKEY$:IF A$="" THEN 1310 

CLS: PRINT: PRINT: PRINT 

PRINT" THIS DIET IS SET LOW 

NE WHO "; 

PRINT"IS ONLY MILDLY OVERWEIGHT 

PRINT"SOMEONE VERY OVERWEIGHT CAN LOSE FAIRLY RAPIDLY." 

PRINT" THE PROGRAM WILL DISPLAY FOR YOU A MENU FOR " ; 

PRINT"WHICHEVER MEAL YOU SELECT (BREAKFAST, LUNCH, DINNER, "; 

PRINT"SNACK) . IF YOU DONT LIKE THE SELECTIONS, OR DONT "; 

PRINT"HAVE THOSE PARTICULAR ITEMS ON HAND, JUST REQUEST "i 

PRINT"A DIFFERENT FOOD SELECTION UNTIL YOU FIND ONE THAT SOUNDS APPETIZING. 

IF YOU WANT TO SELECT 
PRINT'FOR A DIFFERENT MEAL, JUST RETURN TO THE MEAL MENU. 
PRINT 

PRINT" ENTER TO CONTINUE 

A$=INKEY$:IF A5="" THEN 1440 
RESTORE : CLS : PRINT : PRI NT 

PRINT" MEAL SELECTIONS 

PRINT" =============== 

PRINT 

PRINT" SELECT ONE : 

PRINT 

BREAKFAST 

LUNCH 

DINNER 

SNACK 

EXIT TO PROGRAM MENU 



PRINT" 

PRINT" 

PRINT" 

PRINT" 

PRINT" 

AS=INKEY?:IF A$= 

M=VAL(A$) 



1.- 
2.- 
3.- 
4.- 
5.- 
THEN 156 
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1580 IF H<1 OR M>5 THEN 1560 

1590 IP M=5 THEN 1080 

1600 FOR N*=l TO 89:READ S$(N):NEXT N 

1610 ON H GOTO 1620,1640,1660,1680 

1620 CLS:PRINT TAB (24) "BREAKFAST MENU":PRINT TAB(24) "=—===========" 

1630 OOSUB 2210:GOSUB 2110:GOSUB 1930:GOSUB 1980:GOSUB 1900:GOSUB 2020:GOTO 2240 
1640 CLS:PRINT TAB(24) "LUNCH MENU":PRINT TAB(24) "==========" 

1650 GOSUB 2210:GOSUB 2110:GOSUB 1980:GOSUB 1930:GOSUB 1900:GOSUB 2020:GOTO 2240 
1660 CLS:PRINT TAB (24) "DINNER MENU":PRINT TAB(24) "===========" 

1670 GOSUB 2210:GOSUB 2110:GOSUB 1800:GOSUB 1900:GOSUB 2020:GOTO 2240 
1680 CLS:PRINT TAB(24) "SNACK MENU":PRINT TAB(24) *==========" 

1690 GOSUB 1900:GOSUB 2020:GOTO 2240 

1700 DATA "1/2 CUP BEETS", "1/2 CUP CARROTS" , "1/2 CUP ONIONS" 

1710 DATA "1/2 CUP GREEN PEAS", 1/2 CUP PUMPKIN", "1/2 CUP WINTER SQUASH" 

1720 DATA "1/2 CUP TURNIPS", "1 MEDIUM CARROT", "TOMATO CATSUPU TBSP.)" 

1730 DATA "1 CUP ASPARAGUS", "1 CUP BROCOLLI", "1 CUP BRUSSELS SPROUTS" 

1740 DATA "1 CUP CABBAGE", "1 CUP CAULIFLOWER" , "1 CUP CELERY" 

1750 DATA "1 CUP CUCUMBERS", "1 CUP EGGPLANT" , "LETTUCE" 

1760 DATA "1 CUP MUSHROOMS", "1 CUP OKRA","l CUP PEPPERS" 

1770 DATA "1 CUP RADISHES", "1 CUP RHUBARB", "1 CUP SAUERKRAUT" 

1780 DATA "1 CUP STRING BEANS", "1 CUP SUMMER SQUASH", "1 CUP TOMATOES" 

1790 DATA "1 CUP ZUCCHINI", "1 CUP SPINACH", "1 CUP GREENS" 

1800 N=RND(30) 

1810 PRINT S$(N):PRINT:RETURN 

1820 DATA "SMALL APPLE" , "1/2 CUP APPLE SAUCE(NO SUGAR ADDED)" 

1830 DATA "2 MEDIUM APRICOTS", "1/2 SMALL BANNANA","10 CHERRIES" 

1840 DATA "2/3 CUP BLUEBERRIES" , "1/4 MEDIUM CANTALOUPE", "2 DATES" 

1850 DATA "2 FIGS", "1/2 SMALL GRAPEFRUIT" , "12 GRAPES" 

1860 DATA "1/8 MEDIUM HONEYDEW","l SMALL ORANGE", "1 SMALL PEAR" 

1870 DATA "1/2 CUP ORANGE JUICE", "1 MEDIUM PEACH" 

1880 DATA "1/2 CUP PINEAPPLE" , "2 MEDIUM PLUMS", "2 MEDIUM PRUNES" 

1890 DATA "2 TBSP RAISINS", "1 CUP STRAWBERRIES" , "1 LARGE TANGERINE" 

1900 N=RND(22) 

1910 PRINT SS(N+30):PRINT:RETURN 

1920 DATA "1 CUP LOW FAT MILK (OR BUTTERMILK OR YOGURT) " 

1930 PRINT SS(53):PRINT:RETURN 

1950 DATA "1 TBSP CREAM CHEESE", "1 TSP MAYONNAISE" 

1960 DATA "2 TSP FRENCH DRESSING", "2 TSP OIL/VINEGAR DRESSING" 

1970 DATA "1 TSP ROQUEFORT DRESSING", "1 TSP THOUSAND ISLAND DRESSING" 

1980 N=RND (9):IF M=l AND N>4 THEN 1980 

1990 PRINT SSIN+53) :PRINT:RETURN 

2000 DATA "TEA OR COFFEE (NO SUGAR), OR BOUILLON" , "PICKLES (NOT SWEETENED)" 

2010 DATA "SUGAR-FREE SOFT DRINK" , "LETTUCE AND TOMATO SALAD" 

2020 N=RND(4):IF M=4 AND N=2 THEN 2020 

2030 IF M=l AND N>1 THEN 2020 

2040 PRINT S$(N+62) : PRINT:RETURN 

2050 DATA "1 BISCUIT", "1 SLICE BREAD", "1/2 CUP COOKED CEREAL" 

2060 DATA "3/4 CUP DRY CEREAL", "1/2 ENGLISH MUFFIN" 

2070 DATA "2 MEDIUM PANCAKES (3 IN. DIAMETER)" 

2080 DATA "1 WAFFLE (4 IN. DIAMETER) ", "4 CRACKERS" , "1/2 CUP RICE" 

2090 DATA "1/2 CUP COOKED SPAGETTI OR NOODLES" , "1/2 CUP PEAS OR BEANS (EXCEPT ST 

RING BEANS) " 
2100 DATA "1/3 CUP CORN","l SMALL (2 IN. DIAMETER) BAKED OR BOILED POTATO", "1/2 

CUP MASHED POTATOES" 
2110 N=RND(14) 

2120 IF M=l AND N>7 THEN 2110 
2130 IF M=2 AND N<7 THEN 2110 
2140 IF M=3 AND N<7 THEN 2110 
2150 PRINT SSIN+66) :PRINT:RETURN 

2160 DATA "FISH, 3 OUNCES", "2 HOT DOGS", "BEEF, 2 LUNCHMEAT-SIZE SLICES" 
2170 DATA "CHICKEN OR TURKEY, 2 LUNCHMEAT-SIZE SLICES" 
2180 DATA "LEAN PORK, 2 LUNCHMEAT-SIZE SLICES" 

2190 DATA "2 EGGS", "2 SLICES LUNCHMEAT" , "1/2 CUP COTTAGE CHEESE" 
2200 DATA "2 OZ. AMERICAN, CHEDDAR, MUENSTER, OR SWISS CHEESE" 
2210 N=RND(9) 

2220 IF M=l AND N<6 THEN 2210 
2230 PRINT S$(N+80) :PRINT:RETURN 

2240 PRINT" SELECT: 1-DIFFERENT FOODS, OR 2-RETURN TO MEAL MENU 

2250 A?=INKEY$:IF A$="" THEN 2250 
2260 IF A$="l" THEN 1610 
2270 IF A$="2" THEN 1450 
2280 GOTO 2250 
2290 END 
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GROCERY LIST: by S.P. Wantz 



Electronically prepare for 
those expensive weekly forays in- 
to the super market with this 
handy program. Your computer 
will quiz you with hundreds of 
examples of food and house- 
wares, in an effort to jog your 
marketing memory. This pro- 
gram will make shopping more 
palateable. 
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10 REM GROCERY STORE SHOPPING CHECKLIST 

20 REM RUNS IN LEVEL II BASIC 

30 REM PROGRAM REQUIRES ABOUT 4.7K BYTES OF MEMORY 

50 CLS 

60 PRINT6209, "GROCERY SHOPPER'S CHECKLIST" 

70 PRINT8328,"THIS PROGRAM PROVIDES YOU WITH A CHECKLIST OF" 

80 PRINT8397, "ITEMS SOLD AT GROCERY SUPERMARKETS." 

90 PRINT6521,"USE THE CHECKLIST TO JOG YOUR MEMORY AS YOU" 

100 PRINT8589, "PREPARE YOUR WEEKLY SHOPPING LIST." 

110 GOSUB 510 

120 PRINT6327 , "TO DISPLAY THE LIST OF ITEMS IN THE CHECKLIST," 

130 PRINT6391, "PRESS THE 'ENTER' KEY ON YOUR COMPUTER'S" 

140 PRINT6455, "KEYBOARD." 

150 GOSUB 510 

160 N=0 

170 GOSUB 300 

180 M=M+1 

190 READ AS,BS 

200 IF A5="NEXT" THEN 280 

210 IF B$="NEXT" THEN 270 

220 PRINT AS; TAB(30) BS 

230 IF M<12 THEN 180 

240 M=0: GOSUB 500 

250 GOTO180 

260 END 

27 PRINT A? 

280 GOSUB500 

285 IF N=10 THEN 420 

290 GOSUB 300 

295 GOTO180 

300 N=N+1:CLS 

310 ON N GOTO 320,330,340,350,360,370,380, 390,400,410,420 

320 R$="CANNBD GOODS" :GOTO430 

330 RS="JARS AND BOTTLES": GOTO 430 

340 R$="PACKAGED/BOXBD GOODS": GOTO 430 

350 R$="PAPER/PLASTIC PRODUCTS" : GOTO 430 

360 R$="DAIRY PRODUCTS": GOTO430 

370 R$="FROZEN FOODS": GOTO430 

380 R$="MEATS/FOWL/SEAFOOD": GOTO 430 

390 RS="FRESH VEGETABLES": GOTO 430 

400 R$="FRESB FRUIT": GOTO 430 

410 R$="MISCELLANEOUS": GOTO 430 

420 PRINT@532,"END OF LIST": GOTO 260 

430 PRINT6532,R$ 

500 REM 

510 REM SUBROUTINE— PAUSE— 

520 PRINTS896," TO CONTINUE, PRESS 'ENTER' KEY.":INPUT HS 

530 CLS: M=0 

540 RETURN 

600 DATA PEAS, CORN, PORK & BEANS, STRING BEANS, TOMATOES, LIMA BEANS 

610 DATASAUERKRAUT, HOMINY, ASPARAGUS, TOMATO JUICE, APPLE SAUCE, TOMATO SAUCE 

620 DATA NAVY BEANS, MIXED VEGETABLES, TOMATO PUREE, CARROTS , BEETS , SPINACH 

630 DATAVEGETABLE JUICE, PEACHES , PEARS , CHERRIES , FRUIT COCKTAIL, PUMPKIN 

640 DATAAPRICOTS, PINEAPPLE, CRANBERRY SAUCE, FRUIT JUICE, PRUNES , SOUPS 

650 DATACONDENSED MILK, SHORTENING, FLOOR WAX, SOFT DRINKS, BEER, COCOA MIX 

660 DATACOFFEE, PEPPER, SPICES, CHOCOLATE SYRUP, CHILI SAUCE, CHILI POWDER 

670 DATAMUSHROOMS , PEANUTS , HAM, PORK , TUNAF ISH , SALMON 
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680 DATABEEF HASH, SARDINES , SHRIMP, CRABMEAT, OYSTERS, INSECTICIDE 

690 DATA METAL CLEANER, TOILET BOWL CLEANER, SCOURING POWDER, TOMATO PASTE 

700 DATA NEXT 

710 DATA APPLE BUTTER, MUSTARD, PICKLES .OLIVES , INSTANT COFFEE, SALAD DRESSING 

720 DATACATSUP, INSECTICIDE, DISINFECTANT, BLEACH, COOKING OIL,VINEGAR 

730 DATAMAYONNAISE, WINE, SOFT DRINKS, BEER, PEANUT BUTTER, JELLY 

740 DATAHONEY, HORSERADISH, SAUERKRAUT, SPAGHETTI SAUCE, SPICES, SOY SAUCE 

750 DATABOUILLON CUBES, TACO SAUCE, FLOOR WAX, FURNITURE WAX 

760 DATASYRUP, DISTILLED WATER, CARPET SHAMPOO, BARBECUE SAUCE 

770 DATASOFT DRINK MIX, BEETS, STEAK SAUCE, GLASS CLEANER, ,NBXT 

780 DATABROWN SUGAR, GRANULATED SUGAR, POWDERED SUGAR, POWDERED MILK 

790 DATAEGGS , DEODORI ZER , TEABAGS , SALT, BREAD , ROLLS , CAKE , DOUGHNUTS 

800 DATABREADCRUMBS,COLD CEREAL, HOT CEREAL, BLEACH, LIQUID DETERGENT, FABRIC SOFTEN 

ER 
810 DATAHAND SOAP, LAUNDRY SOAP, DISHWASHING DETERGENT, SOUP MIX 
820 DATAINSTANT POTATOES , POTATO CHIPS, SNACKS, CRACKERS, BAKING SODA SOAP PADS 
830 DATAFURNITURE WAX, STEEL WOOL, WASHING SODA, CLEANING POWDER 
840 DATATOILET BOWL CLEANER, GRATED CHEESE ,PRETZLES , SPAGHETTI 
850 DATAPASTA, NOODLES, LASAGNA, RICE, MACARINI, PANCAKE MIX 
860 DATACAKE MIX, FLOUR, CANDY, COOKIES, GRITS, CORN STARCH 
870 DATASTARCH, CHARCOAL, PET FOODS, BABY FOOD, PUDDING, GELATIN DESERTS 
880 DATAPRUNES, POPCORN, COCKTAIL SAUCE, TACO SHELLS, TACO MIX, BORAX 
890 DATATOILET BOWL FRESHENER, DISHWATER SOFTENER, GRAVY MIX, DRIED BEANS 
900 DATADRIED PEAS, SOFT DRINK MIX, COFFEE POT FILTERS, DIET FOODS 
910 DATASALAD DRESSING MIX, PIE SHELLS , YEAST, CREAM OF TARTAR 
920 DATA SHAKE 'N BAKE, GRATED CHEESE, MUFFIN MIX 
925 DATA TAPIOCA, NEXT 

930 DATANAPK INS, PAPER PLATES, PAPER CUPS, PAPER TOWELS, TOILET PAPER, FACIAL TISSUE 
940 DATAWAX PAPER, FREEZER PAPER, TRASH BAGS, SANDWICH BAGS 
950 DATAALUMINUM WRAP, BAKING BAGS, VACUUM CLEANER BAGS, NEXT 
960 DATAWHOLE MILK, SKIM MILK, BUTTER MILK, CHOCOLATE MILK 
970 DATAICE CREAM, ICE MILK, WHIPPING CREAM, SOUR CREAM, BUTTER, EGG NOG 
980 DATACOFFEE CREAM, SOLID CHEESE .COTTAGE CHEESE .MARGARINE 
990 DATACREAM CHEESE, NEXT 

1000 DATAPIE, CAKE, VEGETABLES, TV DINNERS, FISH STICKS, FISH FILET 
1010 DATAFRUIT JUICE, SHRIMP, MEAT PIES, MIXED VEGETABLES .FRENCH FRIES, PIZZA 
1020 DATAPIE SHELLS, WHIPPED TOPPING, WAFFLES, NEXT 

1030 DATALUNCH MEAT, GROUND BEEF, BEEF ROAST, STEW MEAT, SOUP MEAT, STEAKS 
1040 DATAPORK CHOPS, PORK ROAST, LIVER, BACON, CHICKEN, TURKEY, VEAL LAMB 
1050 DATAFRANKFURTERS,PORK SAUSAGE, SMOKED HAM, SMOKED SHOULDER 
1060 DATAFISH, SHRIMP, NEXT 

1070 DATAPOTATOES , ON IONS , TOMATOES , LETTUCE , CUCUMBERS , RADI SHES 
1080 DATACARROTS, CABBAGE, EGG PLANT, KALE, SPINACH, BEETS 

1090 DATAPEAS,LIMA BEANS, CELERY, CAULIFLOWER, STRING BEANS, GARLIC CLOVES 
1100 DATABROCCOLI, BRUSSELS SPROUTS .MUSHROOMS TURNIPS, SWEET POTATOES , PEPPERS 
1110 DATA SQUASH, ASPARAGUS, YAMS, PUMPKIN, NEXT 
1120 DATAORANGES, GRAPEFRUIT, LEMONS, LIMES, APPLES, GRAPES 
1130 DATABANANAS , PEARS , PEACHES , PLUMS , CRANBERRIES .AVOCADO 
1140 DATA MELONS, PINEAPPLE, CHERRIES, NEXT 

1150 DATASKIN CREAM, HAIR SHAMPOO, MOUTHWASH, TOOTHPASTE, MAGAZINES, RAZOR BLADES 
1160 DATASHAVING CREAM, AFTER SHAVE LOTION , ASPIRIN, CIGARETS , MATCHES, LIGHTER FLUID 
1170 DATA PANTY HOSE ,ANTI-PERSPIRANT, NEXT 
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HOME FINANCE PROGRAM: by Dan Booth 



Mortgage loan amortization 
and payment schedules, an- 
nuities calculations, owner's cost 
analysis and depreciation 
schedules are all included in the 
Home Finance program. A real 
necessity in this age of inflating 
land values and real estate 
speculation. 



iimMMiizwimciuiuTim 
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50 CLEAR 2000 

85 D$="$###,#.###":E$="S#######,#.»»":G$="$###M, ft. SO ":H$="#S####, #.##": 

90 A1$="INITIAL BALANCE : $" :A2$="NUMBER OF PAYMENTS PER YEAR : " 

92 01$= "REGULAR PAYMENT" :02S="T0TAL OF PAYMENTS" : 03 $=" TOTAL INTEREST PAID" 

94 H1$="VALUE OF INVESTMENT" :H2$="VALUE OF ACCUM. INTEREST" : H3$="T0TAL VALUE" 

95 DEFDBL Q,Y,X,W,P,D,0, J,K,R,C,S,L,H,I 

100 CLS:PRINTTAB(18);"TRS-80 HOME FINANCE PROGRAMS" 

110 PRINT: FRINT'LOAN AMORITIZATION CALC. " ; : PRINTTAB(50) ; "1 " 

120 PRINT: PRINT"LOAN AMORITIZATION SCHEDULE" ;: PRINTTAB (50) ; "2" 

130 PRINT: PRINT'ANNUITIES CALCULATIONS"; :PRINTTAB(50) ; "3" 

140 PRINT: PRINT"HOME OWNERS COST CALC. " ; : PRINTTAB(50) ; "4" 

150 PRINT: PRINT'DEPRECIATION SCHEDULES" ;: PRINTTAB ( 50) ; "5" 

160 PRINT:LINEINPUT"KHICH PROGRAM : " ;XS:X=VAL(XS) : IFX<1 OR X>5 THEN100 

180 ONXGOTO2000, 2600, 3000, 1000, 4000 

1000 CLS: PRINTTAB (14); I "HOME OWNERS REAL MONTHLY COST ESTIMATE" 

1010 A1=0:A2=0:A3=0:A4=0:A5=0:A6=0:A7=0:A8=0:A9=0 

1020 PRINT: INPUT"YOUR MONTHLY PAYMENT (WITH PROPERTY TAX) :S";A1 

1025 X=A1*12:PRINT"ANNUALLY THIS AMOUNTS TO : $";X 

1030 PRINT: INPUT'YOUR MORTAGE IS : ?";A2 

1035 INPUT"YOUR ANNUAL INTEREST RATE IS : %";A3 

1040 Q=(A3/100)*A2:GOSUB2850:V=Q 

1045 PRINT"FIRST YEARS INTEREST WILL BE : $",-V 

1050 PRINT: INPUT" ANNUAL PROPERTY TAXES ARE : $";A4 

1055 D=V+A4:PRINT"DEDUCTIBLE INTEREST S TAXES TOTAL : S";D 

1060 PRINT: INPUT"YOU ESTIMATE YOUR IN WHAT TAX BRACKET : %";A5 

1065 A5=A5/100:Q=A5*D:F=Q 

1070 PRINT"YOUR DEDUCTIONS WILL SAVE YOU : " ; USINGG5 ;F 

1075 INPUT"ESTIMATE YOUR PROPERTY VALUE INCREASE NEXT YEAR : %";A6 

1080 A6=A6/100:Q=A6*A2:S=Q 

1085 PRINT"YOUR PROPERTY WILL INCREASE IN VALUE : ";USINGGS;S 

1090 M=ABS(X-D) :PRINT"YOUR MORTAGE REDUCTION WILL AMOUNT TO : $";H 

1095 N=F+S+M: PRINT "YOUR TOTAL BENEFITS NEXT YEAR WILL AMOUNT TO : S";N 

1100 Q=N/12:0=Q:J=Al-0 

1105 PRINT :PRINT"MONTHLY PAYMENT IS : " ;TAB (35 ) ; USINGGS ; Al 

1110 PRINT"YOUR MONTHLY BENEFITS ARE :";: PRINTTAB (35 );: PRINTUSINGG? ;0 

1115 PRINT"YOUR REAL MONTHLY COST IS : " ; : PRINTTAB(35 ) ; : PRINTUSINGG$; J 

1120 PRINT:PRINT"THE ABOVE RESULTS ARE ESTIMATES ONLY" 

1125 LINEINPUT"PRESS ENTER TO RETURN TO MENU ";XS:GOTO10 

2000 CLS: PRINTTAB ( 15 ); "LOAN AMORITIZATION CALCULATION" :LP=1 : IFPEEK( 14312 ) 063THE 

NLP=0:POKE16425,1 
2005 IFLP=1LPRINTTAB(15)"L0AN AMORITIZATION CALCULATION" :LPRINTSTRING5 (3 , 138) 
2010 PRINT :PRINTA1$;:INPUTA1:IFLP=1LPRINTA1S; USINGGS ;A1 
2015 GOSUB5000: PRINT: PRINTA25; : INPUTV: IFLP=1LPRINTA2$;V 

2020 A2=A2/V/100:X=1+A2:Y=V*A3/12:P=X[Y:B=1/P:C=A1*A2/(1-B) :R=C*A3:K=R-A1 
2060 PRINTSTRINGS(45,"=") : IFLP=1LPRINTSTRING$ (45 , "=") 
2065 PRINT01$;TAB(35);USINGE$;C:IFLP=1LPRINT01$;TAB(35);USINGE$;C 
2070 PRINT02$;TAB(35);USINGES;R:IFLP=1LPRINT02$;TAB(35);USINGE$;R 
2075 PRINT03$;TAB(35);USINGE?;K:IFLP=1LPRINT03S;TAB(35);USINGE$;K 
2080 PRINT: INPUT"CONTINUE (Y/N) " ;C? : IFC5="Y"THEN2000ELSEIFCS="N"THEN10 
2083 GOTO2080 
2600 CLS:PRINTTAB(18);"L0AN AMORITIZATION SCHEDULE" :LP=1 : POKE16425 ,1 : IFPEEK ( 1431 

2)<>63THENLP=0 
2605 IFLP=1LPRINTTAB(20);"LOAN AMORITIZATION SCHEDULES" 
2615 PRINT: PRINT: 1=0 :R=0:H=0:S=0:X=0:A1=0:A4=0:A3=0 

2620 INPUT"BEGINNING BALANCE : ?" ;H: A(0) =H: IFLP=1LPRINT"BEGINNING BALANCE : ?";H 
2630 INPUT"ANNUAL INTEREST RATE % " ,- Al :L= (Al/1 2) /100 : IFLP=1LPRINT"ANNUAL INTEREST 
RATE %";A1 
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2640 INPUT-LOAN TERM (IRS, MONTHS) : " ;N,A6 :N=N*12+A6: IFLP=1LPR1NT"L0AN TERM (YRS, 
MONTHS) : ";N/12-A6,A6 

2645 INPUT"* OF MONTH OF FIRST PAYMENT : " ; A7 : IFA7=0A7=1 

2646 PRINT-ENTER FOR COMPUTER CALC OF PAYMENT" 
2648 INPUT"MONTHLY PAYMENT : S" ;X: IFX>0THEN2665 

2655 X=(l+L) :Y=-N:P=X[Y:X=H*(L/(1-P)) :X=(INT(100*X) )/100 
2665 GOSUB2670:GOTO2685 

2670 CLS:PRINTe64,"BAL";USINGE$;A(0):IFLP=lLPRINTSTRING$(3,138) 

2671 IFLP=1LPRINT"BALANCE " ; : LPRINTUSINGE?; A( 0) ; 

2673 PRINT§82, "INTEREST %" ;A1: IFLP=1LPRINT" INTEREST %",-Al; 

2675 PRINT8100, "MONTHLY PAYMENT" ,-: PRINTUSINGD$;X: IFLP=1LPRINT" MONTHLY PAYMENT 

";:LPRINTUSINGD$;X 
2680 PRINT"MONTH PRINCIPLE INTEREST INT TO DATE BALANCE" 

26 81 IFLP=1LPRINT"M0NTH PRINCIPLE INTEREST INT TO DATE BALANCE" 
2682 RETURN 

2685 A3=A7:N=N+A7-1 

2687 A9=0:A(10)=0:FORZ=A3TOA3+12-A7 

2690 PRINTZ;:IFLP=1LPRINTZ; 

2695 I=H*L:I=(INT(100*I))/100:S=S+I:A4=X-I:H=H-A4 

27 03 R=R+A4:A9=A9+I:A(10)=A(10)+A4 

2704 PRINTTAB(B);USINGD$;A4;:IFLP=1LPRINTTAB(8);USINGDS;A4; 
2706 PRINTTAB(23),-USINGG$,-I;:IFLP=1LPRINTTAB(23),-USINGGS;I; 

2710 PRINTTAB(35);:PRINTUSINGES;S,-:IFLP=1LPRINTTAB(35);USINGE$;S; 

2711 PRINTTAB(49);USINGESjH:IFLP=lLPRINTTAB(49);USINGES;H 

2712 IFZ=-1THEN2720 

2713 IFH<=XTHENI=(INT(100*(H*L)))/100:S=S+I:A4=H~I:Z=-1:H=0:GOTO2704 

2714 IFZ=NTHENZ=-1:GOTO2720 

2715 NEXTZ:A3=A3+13-A7:A7=1 

2720 PRINT"TOTALS";:PRINTTAB(10),-"$";A(10);:PRINTTAB(25);"S";A9; 

2721 IFLP=1LPRINT"TOTALS";:LPRINTTAB(10),-"$";A(10);:LPRINTTAB(25);"S";A9 
2725 INPUT" CONTINUE Y/N" ;CS : IFC$O"Y"THEN2800 

2727 IF(C$="Y")AND(Z=-1)THEN2800 

2730 GOSUB2670:GOTO2687 

2800 CLS:PRINT6256, "TOTAL PRINCIPLE PAID "; :PRINTUSING ES;R 

2805 IFLP=1LPRINTSTRING$(3,138) :LPRINT"TOTAL PRINCIPLE PAID " ; : LPRINTUSINGES;R 

2810 PRINT"TOTAL INTEREST PAID " ; : PRINTUSING ES;S 

2813 IFLP=1LPRINT"T0TAL INTEREST PAID " ; : LPRINTUSINGE$;S 

2815 G=H*L/30 

2818 PRINT: IFLP=1LPRINT" " 

2820 IFH=0THEN2830 

2823 PRINT"FINAL PAYMENT IS " ; : PRINTUSINGES;H 

2824 PRINT" INTEREST PER DAY IS " ; : PRINTUSINGD$,-G 

2825 IFLP=1LPRINT"FINAL PAYMENT IS ";USINGES;H 

2826 IFLP=1LPRINT" INTEREST PER DAY IS ";USINGD$;G 
2830 INPUT"AGAIN ";CS: IFCS="Y"THEN2600 

2845 IFCS="N"THEN10ELSE2830 
2850 RETURN 

3000 POKE16425,l:LP=l:IFPEEK( 14312) >127THENLP=0 

3001 CLS:PRINTTAB(18);"ANNUITIES CALCULATIONS" 

3005 PRINT:PRINT:PRINT"FUTURE VALUE OF A SINGLE DEPOSIT";TAB(55) "1" 

3010 PRINT: PRINT" PRESENT VALUE REQUIRED FOR A FUTURE VALUE" ,-TAB(55) "2" 

3015 PRINT:PRINT"FUTURE VALUE OF REGULAR DEPOSITS", -TAB (55) "3" 

3020 PRINT: PRINT'REGULAR DEPOSITS REQUIRED TO ACHIEVE A FUTURE VALUE" ;TAB( 55) "4" 

3030 PRINT: PRINT-EXIT THIS PROGRAM";TAB(55) "5" 

3035 PRINT:LINBINPUT"WHICH PROGRAM : ";X$:X=VAL(X$) :IFX<1ORX>5THEN3000 

3050 ONXGOTO3100, 3200, 3300, 3400, 10 

3100 CLS:PRINTTAB(10); "FUTURE VALUE OF A DEPOSIT" 

3103 IFLP=1LPRINT"FUTURE VALUE OF A DEPOSIT" :LPRINTSTRING$ (3 ,138) 

3105 INPUT"INITIAL INVESTMENT : $" ; Al : IFLP=1LPRINT" INITIAL INVESTMENT : $";A1 

3110 GOSUB5000 

3115 PRINT: INPUT'NUMBER OF COMPOUNDING PERIODS/YR : " ;V 

3116 IFLP=1LPRINT"NUMBER OF COMPOUNDING PERIODS/YR :":V 

3120 A2=A2/V/100:X=1+A2:Y=(A3/12)*V:P=X[Y:Q=P*A1:W=Q-A1:GOSUB5100 

3130 GOSUB9500:GOTO3000 

3200 CLS:PRINTTAB( 12), -"PRESENT VALUE REQUIRED FOR A FUTURE VALUE" 

3205 IFLP=1LPRINT"PRESENT VALUE REQUIRED FOR A FUTURE VALUE" :LPRINTSTRING$ (3 , 138 

3210 INPUT'FUTURE VALUE EXPECTED : S" ;A1 : IFLP=1LPRINT"FUTURE VALUE EXPECTED : S" 

3220 GOSUB5000: PRINT: INPUT"NUMBER OF COMPOUNDING PERIODS/YR : ";V 

3221 IFLP=1LPRINT"NUMBER OF COMPOUNDING PERIODS/YR : ";V 
3225 A2=A2/V/100:X=1+A2:Y=-A3/12*V:P=X[Y 

3230 Q=P*A1:W=A1-Q:D=A1:A1=Q:Q=D:PRINT:GOSUB5100:IFLP=1LPRINTAS 

3235 GOTO3130 

3300 CLS:PRINTTAB( 20), -"FUTURE VALUE OF REGULAR DEPOSITS" 

3305 IFLP=1LPRINT"FUTURE VALUE OF REGULAR DEPOSITS" :LPRINTSTRINGS (3 , 138) 

3310 INPUT'DEPOSIT : S";A1: IFLP=1LPRINT"DEP0SIT : 5";A1 

3313 GOSUB3315:GOTO3320 

3315 GOSUB5000: PRINT: INPUT"NUMBER OF DEPOSITS PER YEAR : ";V 

3316 IFLP=1LPRINT"NUMBER OF DEPOSITS PER YEAR : ";V 

3317 PRINT: INPUT'NUMBER OF COMPOUNDING PERIODS/YR : ";T:S=V/T 

3318 IFLP=1LPRINT"NUMBER OF COMPOUNDING PERIODS/YR : ";T 

3319 RETURN 

3320 A2=A2/T/100:X=1+A2:Y=A3/12*T:P=X[Y:Q=(A1*V/T)*((P-1)/A2):A1=A1*A3/12*V 

3330 W=Q-A1: PRINT :GOSUB5100:GOTO3130 

3400 CLS:PRINTTAB(5) "REGULAR DEPOSITS REQUIRED TO ACHIEVE A FUTURE VALUE" 
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3405 IFLP«1LPRIHTTAB(5) "REGULAR DEPOSITS REQUIRED TO ACHIEVE A FUTURE VALUE" :LPR 

INTSTRING$(3,138) 
3410 INPUT"FUTURE VALUE : S";A1:GOSUB3420 :GOSUB3315 :A2=A2/T/100:X=1+A2 :Y=A3/12* 

T:P=X[Y:Q=A1*(A2/(P-1)):Q=Q*T/V:C=Q*V*A3/12 
3415 GOTO3430 

3420 IFLP=1LPRINT"FUTURE VALUE : S";A1:RETURN 
3430 PRINTSTRING$(50,"=") : IFLP=1LPRINTSTRING$ (50 , "=") 
3435 PRINT"REGULAR DEPOSIT REQUIRED" ;TAB(35 ) ;USINGG$;Q: IFLP=1LPRINT"REGULAR DEPO 

SIT REQUIRED";TAB(35) ;USINGGS;Q 
3440 W=A1-C:Q=A1:A1=C:GOSUB5105:GOTO3130 
4000 CLS:PRINTTAB(25); "DEPRECIATION SCHEDULES" 
4002 POKE 16425, 1 :LP=1: IFPEEK(14312)O63THENLP=0 
4010 PRINT: PRINT"STRAIGHT LINE METHOD"; : PRINTTAB(50) ; "1" 
4020 PRINT: PRINT"SUM OF THE YEARS DIGITS METHOD" ; : PRINTTAB ( 50) ; "2" 
4030 PRINT: PRINT"DECLINING BALANCE METHOD" ;: PRINTTAB ( 50) ; "3" 
4040 PRINT: PRINT"EXIT THE PROGRAM"; :PRINTTAB(50) ; "4" 
4050 PRINT: INPUT"WHICH PROGRAM" ;X : IFX=4THEN100 
4060 IF(X<1)OR(X>4)THEN4000 
4065 A(20)=X 

4070 ONXGOTO4100,4200,4300 

4100 CLS:A$="STRAIGHT LINE":B$=" METHOD" : PRINTTAB ( 23 ); A$ ;B$ : PRINT:GOSUB4908 
4105 I=18:X=A3/A4:GOSUB4500:GOSUB4550:GOTO4000 
4200 CLS:A$="SUM OF THE YEARS" :B$=" DIGITS METHOD" 
4205 PRINTTABI13) ;AS;B$:PRINT:GOSUB4900 
4210 E=0:FORZ=1TOA4:E=E+Z:NEXTZ 
4220 1=18 :GOSUB4500:GOSUB4 550 :GOTO4000 
4300 CLS:A$="DECLINING" 
4305 B$=" BALANCE METHOD" 
4307 PRINTTAB(22);A$;B$:I=22 
4310 GOSUB4950 

4340 A3=A3/100/A4:GOSUB4500:GOSUB4550:GOTO4000 
4500 CLS : PRINTTAB! I) ;A$;B$:PRINTTAB(3); "YEARS", -:PRINTTAB( 25); "DEPRECIATION"; 

4505 IFLP=1LPRINTA$;B$ :LPRINTTAB(10) ; "YEARS" ; : LPRINTTAB(30) ; "DEPRECIATION"; 

4506 PRINTTAB! 48); "DEPRECIATED": PRINTTAB! 28) ; "VALUE"; : PRINTTAB! 52) ; "VALUE" 

4510 IFLP=1LPRINTTAB(60) ; "DEPRECIATED" :LPRINTTAB( 33) ; "VALUE"; : LPRINTTAB (63) ; "VAL 

UE": RETURN 
4550 A7=0:V=0:U=A1 
4555 F0RZ=A7T0(A7+11) 
4560 GOSUB4600 
4563 IFZ=0THENX=0 

4565 PRINTTAB(4);Z;:IPLP=1LPRINTTAB(11);Z; 

4566 PRINTTAB(24);:PRINTUSING GS;X; : IFLP=1LPRINTTAB(29) ;USINGG$;X; 

4567 PRINTTAB146) ; : PRINTUSING ES ;V: IFLP=1LPRINTTAB (58) ;USINGE$;V 
4570 IFZ=>A4THEN4590 

4575 NEXTZ:A7=A7+12 

4580 INPUT"CONTINUE (Y/N) " ;C$ : IFC$O"Y"THEN4000+A( 20) *100 

4585 CLS:GOSUB4500:GOTO4555 

4590 GOSUB9500:GOTO4000 

4600 W=A(20) :ONWGOTO4670, 4680, 4690 

4670 X=A3/A4 :V=U : U=A1-X: A1=U: RETURN 

4680 IFVO0THENX=(A4+1-Z)/E*A3:U=A1-X:A1=U:V=U: RETURN 

4685 V=U:RETURN 

4690 IFVO0THENX=U*A3:U=A1~X:A1=U:V=U:RETURN 

4695 V=U:RETURN 

4900 PRINT"PURCHASE PRICE" ;: PRINTTAB(30) ; "S" ;: INPUTA1 : IFLP=1LPRINT"PURCHASE PRIC 

E ";USINGH$;A1 
4910 PRINT"RESALE PRICE"; : PRINTTAB130) ; "$"; : INPUTA2: IFLP=1LPRINT"RESALE PRICE "; 

USINGH$;A2 
4920 A3=A1-A2 
4930 PRINT"TERM OF DEPRECIATION (YRS) " ; : PRINTTAB(30) ,- : INPUTA4 : IFLP=1THENLPRINT"T 

ERM OF DEPRECIATION (YRS) : " ;A4 :RETURNELSERETURN 
4950 PRINT"PURCHASE PRICE"; : PRINTTAB(30) ;"$";: INPUTA1 : IFLP=1LPRINT"PURCHASE PRIC 

E ";USINGH$;A1 
4960 PRINT'DECLINING BALANCE FACTOR" ;: PRINTTAB(30) ;"%";: INPUTA3: IFLP=1LPRINT"DEC 

LINING BALANCE FACTOR % ";A3 
4970 PRINT"TERM OF DEPRECIATION ( YRS) " ; : PRINTTAB(30) ; : INPUTA4 
4980 RETURN 
5000 PRINT: INPUT"ANNUAL INTEREST RATE : %" ;A2: IFLP=1LPRINT"ANNUAL INTEREST RATE 

: *",-A2 
5010 PRINT: INPUT'TERM (YEARS, MONTHS) : " ;A3,A4 :PD=A3:A3=A3*12+A4: IFLP=1LPRINT"T 

ERM (YEARS, MONTHS) : ";PD,A4 
5015 RETURN 

5100 PRINTSTRING$(50,"=") : IFLP=1LPRINTSTRING$(50, "=") 
5105 PRINTH1$;TAB(35);USINGE$;A1:IFLP=1LPRINTH1S;TAB(35),-USINGE$;A1 
5110 PRINTH2?;TAB(35);USINGES;W:IFLP=1LPRINTH2S;TAB(35);USINGES;W 
5115 PRINTH3$;TAB(35);USINGE$;Q:IFLP=1LPRINTH3$;TAB(35);USINGE$;Q 
5120 RETURN 
9500 FORZ=1TO2000:NEXTZ: RETURN 
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TRIP MILEAGE: by James P. Morgan 



By using this handy program, 
you can find the exact interstate 
highway mileage between major 
cities en route on your next trip. 
Driving times at various speeds 
and full consumption figures are 
also computed by the program. 
An excellent choice in the age of 
the energy crisis. 



•* Tim nsifta is.,.. .1 

' m kwwb «• n-m is 43 mis m is mums' 

TK'KOuraOI 46.W IS. 41- KMfiw 27 "lJUTES" 

'■ II* KOUIfft «T~ 48 IW IS" 39 HOURS (Mi 43 MIMES" - 



. Tire- PE0U1RED OT 52 IW IS 36 •• H3URS .Ml 48 MIME 

'TIIC KWIKTJ AT 54IW1S 35 HOURS Ml 18 MIMES 

-TIIC RE9U1RO AT 56 IW IS 34- HOURS m -3 H1IMIS 

: tUt'KQUKQ AT 58 IW IS 32 HOURS Ml '52 MIMES ' 

TINT BEBUIKB AT 69 IW IS 31 HOURS «d 46 MIMES 
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TIIC PEMIRQ AT 64IW1S 29-HMSAffl 4' MINUTES 

TIIC KSU1KJ AT 66 IW IS 28 HOURS Ml 53 MIME 

EWEP TIC HJGEP tf KWS PEP MY YOU L»I TO »FT - 



5 DIM HI(33,32) 

40 PRINTei5,"U.S. MILEAGES AND TRIP ESTIMATOR" : PRINT 

50 PRINT'THIS PROGRAM WILL FIND THE MILEAGE BETWEEN MAJOR 

60 PRINT"U.S. CITIES, DETERMINE DRIVING TIMES AT VARIOUS 

70 PRINT'AVERAGE SPEEDS, AND DETERMINE DRIVING DAYS BASED ON 

80 PRINT'YOUR CHOICE OP HOURS PER DAY DRIVING TIME. YOU CAN 

90 PRINT-CUSTOMIZE THIS PROGRAM FOR YOUR SPECIFIC LOCATION 

100 PRINT-BY ADDING YOUR CITY OR TOWN TO THE PROGRAM. IF YOU 

110 PRINT"WISH TO DO SO, ANSWER YES WHEN I ASK FOR 'MODIFICATION?' 

120 PRINT" AND 'NO' TO MOVE ON TO THE LIST OF CITIES." 

130 REM SETS UP MILEAGE ARRAY B=ROWS, A=COLUMNS 

150 FOR A=l TO 33 

160 FOR B=l TO 32 

170 READ MI(A,B) 

180 NEXT B:NEXT A 

190 PRINT: INPUT "MODIFICATION" ;AS 

200 IF AS="YES" THEN 2000 

210 IF A$="NO" THEN 230 

220 PRINT"! DON'T UNDERSTAND, YES OR NO?" : GOTO 190 

225 REM LIST OF THE 32 CITIES DATA FOR THE 33 'D IS ZEROED 

230 CLS:PRINT"THE LIST OF CITIES IS AS FOLLOWS: ": PRINT 

235 PRINT'l ATLANTA", "2 BOSTON", "3 CHEYENNE", "4 CHICAGO" 

240 PRINT"5 CINCINNATI", "6 CLEVELAND" , "7 DALLAS", "8 DENVER" 

245 PRINT"9 DES MOINES", "10 DETROIT", "11 HOUSTON", "12 INDIANOPOLIS" 

250 PRINT"13 KANSAS CITY", "14 LOS ANGELES", "15 LOUISVILLE", "16 MEMPHIS" 

255 PRINT"17 MILWAUKEE", "18 MINNEAPOLIS", "19 NEW ORLEANS", "20 NEW YORK" 

260 PRINT"21 OMAHA", "22 PHILADELPHIA", "23 PITTSBURGH" , "24 PORTLAND, ORE" 

265 PRINT"25 ST LOUIS", "26 SALT LAKE", "27 S.fRANCISCO" , "28 SEATTLE" 

270 PRINT"29 TOLEDO", "30 TULSA", "31 WASH. D.C.","32 WICHITA" 

275 PRINT"33 YOUR CITY/TOWN (WITH MODIFICATION)" 

281 REM INPUTS AND CALCULATIONS 

285 PRINT: INPUT'INPUT THE NUMBER OF DEPARTURE CITY";A 

290 INPUT"INPUT THE NUMBER OF DESTINATION CITY";B 

295 CLS:PRINT"THE TOTAL DISTANCE IS "MI(A,B) 

296 REM C=MPH D=GROSS TIME E=WHOLE t LEFT OF DECIMAL F=THE FRACTION RIGHT OF 

THE DECIMAL 

297 REM G=THE WHOLE MINUTE DERIVED FROM 60MIN TIMES THE FRACTIONAL HOUR 
300 FOR C=44 TO 66 STEP 2:D=MI (A,B)/C:E=INT(D) :F=D-E 

302 G=INT(60*F) 

305 PRINT"TIME REQUIRED AT "C"MPH IS "E" HOURS AND "G"MINUTES" 

310 NEXT C 

320 REM A1=DRIVING DAY IN HOURS Bl=GROSS DAYS 

330 INPUT"ENTER THE NUMBER OF HOURS PER DAY YOU LIKE TO DRIVE" ;A1 

335 CLS:PRINT"THE TOTAL DISTANCE IS "MI(A,B) 

340 FOR C=44 TO 66 STEP 2:D=MI (A,B)/C: Bl-D/Al 

346 REM Cl=WHOLE # GROSS DAYS Dl=FRACTIONAL DAY El=HOURS OF FRACTIONAL DAY DER 
IVED FROM D1*DRIVING DAY , , , 

350 C1=INT(B1): D1=B1-C1: E1=(D1*A1) :F1=E1-INT(E1) :G1=INT (Fl*60 ) :H1=INT(E1) :GOTO 
360 

355 C1=0:H1=INT(D) :F1=D-H1:G1=INT(F1*60) 

360 PRINT"AT "C"MPH IT WILL TAKE "Cl'DAYS "Hl'HOURS "G1"MINUTES" 

365 NEXT C 

370 INPUT"AVERAGE MILES PER GALLON YOUR CAR ON A TRIP";A2 

375 INPUT"AVERAGE PRICE PER GALLON, GASOLINE" ;B2:C2=MI (A, B) *B2/A2 

377 IF B2>1.50 THEN PRINT "YOU FORGOT THE DECIMAL POINT" :GOT0375 

379 Z$="S$###.#« ...ESTIMATED COST FOR FUEL" 



174 



380 PRINTUSING ZS;C2 

385 INPUT'FOR INFORMATION ON ANOTHER TRIP, TYPE 'YES' .OTHERWISE' NO' " ;A$ 

390 IF A$="YES" THEN 230 

395 IF A$="NO"THEN 3000 

400 PRINT'I DON'T UNDERSTAND. YES OR NO?" : GOTO 385 

405 REM DATA ATLANTA NEXT 3 

450 DATA 0,1037,1442,674,440,670,7 95,1398,870,609,789,493,7 98,2182 

460 DATA 382,371,761,1068,479,841,986,741,687,2601,541,1878,2496 

470 DATA 2618,640,770,605,903 

475 REM DATA BOSTON NEXT 3 

480 DATA1037, 0,1907, 963, 840, 628, 1750, 1949, 1280, 695, 1804, 905, 1391 

490 DATA2979, 941, 1296, 1050, 1368, 1507, 206, 1412,296, 560, 3046, 1141 

500 DATA2343, 3095, 2976, 739, 1537, 429, 1586 

505 REM DATA CHEYENNE NEXT 3 

510 DATA1442 ,1907, 0,954, 1174, 127 9, 869, 100, 627, 1211, 1107, 1068, 650 

520 DATA1137, 1161, 1101, 987, 788, 1360, 1745, 495, 1677, 1390, 1159, 901 

530 DATA436, 1186, 1228, 1176, 765, 1611, 583 

535 REM DAT CHICAGO NEXT 3 

540 DATA674, 963, 954, 0,287, 335, 917, 996, 327, 2666, 1067, 180, 500, 2054 

550 DATA291, 530, 87, 405, 912, 802, 459, 738, 452, 2083, 290, 1390, 2141 

560 DATA2013,232,683,671,696 

565 REM DATA CLEVELAND NEXT 3 AND SO ON 

570 DATA440, 840, 117 4, 287, 0,244, 920, 1165, 570, 259, 1030, 106, 590, 2197 

580 DATA101, 466 8, 375, 6 92, 7 86, 647, 6 93, 567, 287, 2333, 340, 1610, 2362, 2300 

588 DATA200, 736, 481,787 

600 DATA672, 628, 1279, 335, 244, 0,1159, 1321, 652, 170, 1273, 294, 779, 2367 

610 DATA345, 712, 422, 740, 1030 ,473, 784, 413, 129, 2418, 529, 1715, 2467 

620 DATA 2348,111,925,346,975 

630 DATA795, 1748, 869, 917, 920, 1159, 0,781, 684, 1143, 243, 865, 489 

640 DATA1387, 819, 452, 991, 936, 496, 1552, 644, 1452, 1204, 2009, 630 

650 DATA1242, 1753,2087,1084,257,1319,365 

660 DATA 1398,1949,100,996,1164,1321,781,0,669,1253,1019,1058 

670 DATA 600,1059,1120,1040,1029,841,1273,1771,537,1691,1411 

680 DATA 1238,857,504,1235,1307,1218,681,1616,509 

690 DATA 870,1280,627,327,571,652,684,669,0,584,905,465,195 

700 DATA 1727,566,599,361,252,978,1119,132,1051,7663,1786,333 

710 DATA1063, 1815, 1749, 549, 443, 984, 392 

720 DATA 699,695,1211,266,259,170,1143,1253,584,0,1265,278,743 

730 DATA 2311,360,713,353,7661,1045,637,716,573,287,2349,513 

740 DATA 1647,2399,2279,59,909,506,940 

750 DATA 789,1804,1107,1076,1029,1273,243,1019,905,1265,0,987 

760 DATA 710,1538,928,561,1142,1157,356,1608,865,1508,1313,2205 

770 DATA 779,1438,1912,2274,1206,478,1375,608 

780 DATA 493,906,1068,181,106,294,865,1058,465,278,987,0,485 

790 DATA 2073,111,435,268,586,796,713,587,633,353,2227,235 

800 DATA 1504,2256,2194,219,631,558,681 

820 DATA 798,1391,650,499,591,779,489,600,195,743,710,485,0 

830 DATA 1589,520,830,451,537,447,806,1198,201,1118,838,1809 

840 DATA 257,1086,1835,687,248,1043,197 

850 DATA 2182,2979,1137,2054,217 9,2367,1387,1059,1727,2311,1538 

860 DATA 2073,860,1589,0,2108,1817,2087,1889,1883,2786,1595 

870 DATA 2426,959,1845,715,379,1131,2276,1452,2631,1400 

880 DATA 382,941,1161,292,101,345,119,1120,566,360,928,111,520 

890 DATA 2108,0,367,697,379,685,748,687,668,388,2320,263,1597 

900 DATA2349, 3205, 301, 659, 582, 710 

910 DATA371, 1296, 1101, 530, 468, 712, 452, 1040, 599, 713, 561, 435, 451, 1817 

920 DATA367, 0,612, 826, 390, 1100, 652, 1000, 752, 2259, 285, 1535, 2125, 2290 

930 DATA 654,401,867,532 

940 DATA761, 1050, 987, 87, 374, 422, 991, 1029, 361, 353, 1142, 26 8, 537 

950 DATA 2087,379,612,0,332,994,889,493,825,539,2010,363,1423 

960 DATA 2175,1940,319,757,758,734 

970 DATA 1068,1368,788,405,692,740,936,841,252,671,1157,586,447 

980 DATA 1889,697,826,332,0,1214,1207,357,1143,857,1678,552 

990 DATA 1186,1940,1608,637,695,1076,644 

1000 DATA479, 1507, 1361, 912, 786, 1030, 496, 1273, 978, 1045, 356, 796 

1010 DATA 806,1883,685,390,994,1214,0,1311,1007,1211,1070,2505 

1020 DATA673, 1738, 2249, 2574, 986, 647, 107 8, 816 

1030 DATA841, 206, 17 46, 802, 647, 473, 1552, 1771, 1119, 637, 1608, 713 

1040 DATA1198, 27 86, 748, 1100, 889, 1207, 1311, 0,1251, 100, 368, 2885 

1050 DATA948, 2182, 2934, 2815, 57 8, 1344, 233, 1394 

1060 DATA986, 1412, 495, 459, 693, 7 84, 644, 537, 132, 716, 865, 587, 201 

1070 DATA1595, 687, 652, 493, 357, 1007, 1251, 0,1183, 895, 1654, 449 

1080 DATA931, 1683, 1638, 6 81, 387, 1116, 298 

1090 DATA741, 296, 1678, 738, 567, 413, 1452, 1691, 1051, 573, 1508 

1100 DATA633, 1118, 2706, 668, 1000, 825, 1143, 1211, 100, 1183,0 

1110 DATA288, 2821, 868, 2114, 2866, 2751, 514, 1264, 133, 1314 

1120 DATA687, 561, 1390, 452, 287, 129, 1201, 1411, 763, 287, 1313, 353 

1130 DATA838, 2426, 388, 752, 539, 857, 1070, 368, 895, 288, 0,2535, 588 

1140 DATA1826 , 257 8 , 2465 , 228 , 984 , 221 , 1034 

1150 DATA2601, 3046, 1159, 2083, 2333, 2418, 2009, 1238, 17 88, 2349, 2205 

1160 DATA2227, 1809, 959, 2320, 2259, 2010, 1678, 2505, 2885, 1654, 2821 

1170 DATA2535, 0,2060, 767, 636, 172, 2315, 1913, 2754, 1739 

1180 DATA541, 1141, 901, 289, 340, 529, 630, 857, 333, 513, 77 9, 235, 257 

1190 DATA1845, 263, 285, 363, 552, 673, 948, 449, 868, 588, 2060, 0,1337 

1200 DATA 2089,2081,454,396,793,447 

1210 DATA1878, 2343, 436, 1390, 1610, 1715, 1242, 504, 1063, 1647, 1438 

1220 DATA1504, 1086, 715, 1597, 15535, 1423, 1186, 1738, 2182, 931, 2114 
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1230 DATA1826, 767, 13 37, 0,7 52, 836, 1612, 117 2, 2047, 1003 

1240 DATA2496, 3095, 1188,2142, 2362, 2467, 17 53, 1235, 1815, 2399, 1912 

1250 DATA22566, 1835, 379, 2349, 2125, 217 5, 1940, 2249, 2934, 1683, 2866 

126 DATA257 8, 636, 2089, 7 52, 0,808, 2364, 1760, 27 99, 1695 

1270 DATA2168, 2976, 1228, 2013, 2300, 2348, 207 8, 1307, 1749, 227 9, 2274 

1280 DATA2194, 1839, 1131, 2305, 2290, 1940, 1608, 2574, 2815, 1638, 2751 

1290 DATA2465, 17 2, 2081, 836, 808, 0,2245, 1982, 284, 1808 

1300 DATA640, 739, 1176, 232, 200, 111, 1084, 1218, 549, 59, 1206, 219, 687 

1310 DATA2276, 301, 654, 319, 637, 986, 57 8, 681, 514, 228, 2315, 454, 1612 

1320 DATA2364, 245, 0,850, 447, 884 

1330 DATA772, 1537, 65, 683, 736, 925, 257, 681, 443, 909, 478, 631, 248 

1340 DATA14 52, 659, 401, 7 57, 6 95, 647, 1344, 3 87, 1264, 984, 1913, 396 

1350 DATA1172, 1760, 1982, 850, 0,1189, 182 

1360 DATA608, 429, 1611, 671, 481, 346, 1319, 1616, 984, 506, 1375, 558 

1370 DATA1043, 26 31, 582, 867, 758, 1076, 107 8, 233, 1116, 133, 221, 2754 

1380 DATA7 93, 2047, 27 99, 26 84, 447, 1189, 0,1239 

1390 DATA903, 1587, 583, 696, 7 87, 975, 365, 509, 392, 940, 608, 681, 197 

1400 DATA14 00, 710, 53 2, 7 34, 6 44, 816, 1394, 29 8, 1314, 1034, 17 39, 447 

1410 DATA1003, 1695, 1808, 884, 182, 1239,0 

1420 DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 

1430 DATA 0,0,0,0,0,0,0,0,0,0 

1440 DATA 0,0,0,0,0,0 

2000 CLS:PRINT"TO MODIFY THE PROGRAM TO INCLUDE YOUR LOCATION 

2010 PRINT"ACCOMPLISH THE FOLLOWING " 

FIND A ROAD ATLAS OR MAP 

COMPUTE THE DISTANCES FROM YOUR CITY/TOWN TO 
EACH OF THE 32 CITIES LISTED. YOU CAN FIND THE 
LIST BY TYPING 'RUN 230'. 
■LIST' LINE 275 AND CHANGE IT TO YOUR TOWN/CITY 
'LIST' LINES 1420-1440. CHANGE DATA TO REPRESENT 
THE MILEAGES YOU FOUND. BE SURE YOU ENTER THEM IN 
ORDER, A COMMA BETWEEN EACH AND NO COMMA AT THE END. 
2100 PRINT'nOW PREPARE YOUR TAPE RECORDER AND A CASSETTE TO RECORD 
2110 PRINT'THE MODIFIED PROGRAM. CHECK WITH ' CLOAD? • TO INSURE A 
2120 PRINT'GOOD DATA TRANSFER. THIS PROGRAM NOW BECOMES YOUR 
2140 PRINT-CUSTOMIZED MILEAGE AND TIME FINDER. HAPPY DRIVING! I" 
2150 END 
3000 CLS:PRINT"SO LONG FROM THE U.S. MILEAGE AND TRIP ESTIMATOR" : END 



2020 


PRINT" 


1. 


2030 


PRINT" 


2. 


2040 


PRINT" 




2050 


PRINT" 




2060 


PRINT" 


3. 


207 


PRINT" 


4. 


2080 


PRINT" 




2090 


PRINT" 
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TAX SHELTER ANALYSIS: by Oren McBride 



Beat the system by using the 
tricks of the rich. This program 
will allow you to find gross 
revenues, operating expenses, 
loan payment schedules and in- 
terest balance and depreciation 
figures for any investment. 




1 REM TAX SHELTER ANALYSIS 

2 REM 

5 REM ********************************************* 
10 DIM NAS(20),GR(20),OE(20),TP(20),TA(20),CB(20) 
20 DIM AP(20),AI(20),DP(20),BV(20),PT(20),LB(20) 

24 REM ********************************************* 

25 REM REQUEST INVESTMENT DATA 

26 REM ********************************************* 
30 CLS: PRINT ,"TAX SHELTER ANALYSIS" : PRINT 

40 PRINT"PLEASE READ AND ANSWER QUESTIONS CAREFULLY" : PRINT 

50 PRINT"WHEN THE DISPLAY STOPS, PRESS ANY KEY TO CONTINUE" 

100 IF INKEY$="" GOTO 100 

110 CLS:PRINT TAB(15);"TAX SHELTER ANALYSIS" 

120 INPUT" INVESTMENT NAME";NAS 

140 INPUT" INVESTMENT TIME IN YEARS (MAXIMUM IS 20) ";T 

150 IF T>20 THEN 140 

160 INPUT"CASH INVESTED IN DOLLARS", -PP 

180 INPUT" AMOUNT BORROWED IN DOLLARS" ;A 

200 INPUT" INTEREST RATE IN %";IR 

250 INPUT" PROPERTY TAX ON INVESTMENT IN * (MAY BE 0)";PX 

270 INPUT" INCOME TAX IN %";TX 

290 INPUT" INVESTMENT CREDIT IN %";CD 

300 INPUT"AMOUNT OF INVESTMENT IN DOLLARS THAT MAY BE DEPRECIATED" ;DI 

310 INPUT"PERIOD OF DEPRECIATION 111 YEARS", -TD 

320 INPUT" ESTIMATED VALUE OF INVESTMENT AT END OF INVESTMENT TIME";RV 

340 INPUT"FIRST YEAR GROSS REVENUE IN DOLLARS" ;GR(1) 

360 INPUT"ANNUAL INCREASE IN GROSS REVENUE IN %",-AN 

380 INPUT'FIRST YEAR OPERATING EXPENSE IN DOLLARS" ;OE (1) 

410 INPUT"ANNUAL INFLATION IN %";IL 

420 K=.12:IR=IR/100:PX=PX/100:TX=TX/100:CD=CD/100:AN=AN/100:IL=IL/100 

430 FOR I=2TO T:GR( I) =GR(I-1> * (AN+1) :OE ( I) =OE ( 1-1) * ( IL+1) :NEXTI 

460 CLS:PRINT TAB(20);NA$ 

470 PRINT "INVESTMENT = "; PP,-TAB(30) ; "INCOME TAX RATE 

480 PRINT "PROP TAX RATE = " ;PX ;TAB(30) ; "INV CREDIT RATE 

490 PRINT "INTEREST RATE = "; IR; TAB(30) ; "RESIDUAL VALUE 

495 PRINTS 340, "THINKING" 

500 R=IR/12.:NP=T*12. 

509 REM ********************************************* 

510 REM CALCULATE LOAN PMT(AP), INTEREST (AD , AND LOAN BAL(LB) 



";TX 
";CD 
";RV 



********* 



************** 



511 REM 

520 P=A*(R*(1.+R) [NP)/((1.+R) [NP-1.) 

550 NO=0:PR=0.:IN=0.:BL=A:XP=0.:TI=0.:TR=0.:TY=0.:NY=0:I=1 

570 IF NP<NO THEN 710 

575 PRINTS 340, "THINKING" 

580 NO=NO+l: IN=BL*R:TI=TI+IN:XP=P 

620 IF BL>P THEN 640 

630 XP=BL+IN 

640 PR=XP-IN:TR=TR+PR:BL=BL-PR:TY=TY+XP 

680 IF NY>=INT(NO/12) THEN 570 

690 NY=INT(NO/12) 

695 PRINT? 340," 

700 AP(I)=TY:AI(I)=TI:LB(I)=BL:TI=0.:TY=0.:I=I+1:GOTO 570 

710 PRINTS 340," 

714 REM ******************************************** 

716 REM CALCULATE DEPRECIATION (DP) , BOOK VALUE (BV) , PROPERTY TAX 

717 REM (PT) .TAXABLE PROFIT(TP) .TAXES (TA) , AND CASH BENEFITS(ob) 

718 REM ********************************************* 
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720 IS=0:FOR 1=1 TO TD: IS=IS+I:NEXT I 

770 TV=DI 

775 FOR 1= 1 TO T:DP(I) =0:IF TD<=0 GOTO 790 

780 FORI=lTOT:IFI>TD GOTO 790 

785 DP(I)=INT(DI*(TD-I+l)/IS+.5) 

790 BV(I)=TV-DP(I) :TV=BV(I) : PT(I) =PX*BV( I) 

830 TP(I)=GR(I)-OE(I)-AI(I)-DP(I)-PT(I) 

840 TA(I)=TX*TP(I) 

850 CB(I)=GR(I)-OE(I)-AP(I)-TA(I)-PT(I) :NEXT I 

859 REM ********************************************* 

860 REM HANDLE INVESTMENT CREDIT(CD) AND RESIDUAL VALUE (RV) 

861 REM ********************************************* 
870 CB(1)=CB(1)+CD*DI 

880 CB(T)=CB(T)+BV(T)+RV-(TX*.4)*(RV~(A+PP-DI)) 

884 REM ********************************************* 

885 REM PRINT RESULTS 

886 REM ********************************************* 

890 PRINT: PRINT TAB(5) ; "GROSS"; TAB (15) ; "OPERATING" ; TAB (27) ; "LOAN" ; TAB (48) ; "LOAN" 

[TAB (57) ;"DEPRE-" 
900 PRINT "YR";TAB(5);"REVENUE";TAB(15);"EXPENSES";TAB(26);"PAYMENT";TAB(36) ;"IN 

TEREST";TAB(47) ,- "BALANCE" ; TAB (56 ) ; "CIATION" 

910 FOR 1=1 TO T 

911 IF 1=1 GOTO 920 

912 IF(I-1)-10*INT((I-1)/10) <> GOTO 920 
914 IF INKEYS ="" GOTO 914 

920 PRINT I,-TAB(4);GR(I);TAB(14);OE(I);TAB(25);AP(I);TAB(35);AI(I);TAB(46);LB(I) 

;TAB(56) ;DP(I) 
930 NEXT I 

935 IF INKEYS="" GOTO 935 
940 PRINT: PRINT TAB(5) ; "BOOK" ;TAB(14 ) ; "PROPERTY"; TAB ( 25) ; "TAXABLE" ;TAB (48) ; "CASH 

950 PRINT "YR";TAB(5); "VALUE", -TAB(16) ; "TAX" ;TAB( 25) ; "PROFIT"TAB(36> ; "TAXES", -TAB ( 
47) ; "BENEFIT" 

960 FOR 1=1 TO T 

961 IF 1=1 GOTO 970 

962 IF(I~1)-10*INT( (I-U/10) <> GOTO 970 
964 IF INKEY? = "" GOTO 964 

970 PRINT I;TAB(4);BV(I);TAB(14);PT(I);TAB(24);TP(I) ; TAB (35) ;TA(I) ; TAB (46) ;CB(I) 
980 NEXT I 

984 REM ********************************************* 

985 REM CALCULATE RETURN ON INVESTMENT AND PAYBACK PERIOD 

986 REM ********************************************* 
990 V=0:FOR 1=1 TO T:V=V+CB(I)/(1+K) [ I :NEXT I 

1030 IF INKEYSO"" PRINT K,V 

1040 IF ABS(V-PP)<=100. GOTO 1080 

1050 K=(K*(V/PP)+K)/2.:GOTO 990 

1080 CM=0:FOR 1=1 TO T:CM=CM+CB(I) :DF=CM-PP: IF DF>=0 GOTO 1160 

1130 NEXT I 

1140 PB=100.:GOTO 1180 

1160 PB=I-DF/CB(I) :K=K*100. :PRINT 

1180 PRINT"PAYBACK PERIOD = ";PB," ROI = ";K;"%" 

1190 END 
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PHONE BILL PROGRAM: by Walter McCahan 



Use this program to determine 
the least expensive way to make 
toll calls. Time of day, date, rate 
charged and applicable dis- 
counts are all considered in com- 
puting your actual toll charges. 
Check the accuracy of Ma Bell's 
billing with your own electronic 
brain. 
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TELEPHONE BILL ANALYSIS 
TRS-80 LEVEL II 
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DIM A(250),D{250),E(250),N(250),H(250),C(250) 

CLS 

PRINT" THIS PROGRAM WILL ANALIZE TOLL TELEPHONE CALLS" 

PRINT" TO ENABLE THE USER TO MAKE A DECESION" 

PRINT" AS TO THE LEAST EXPENSIVE WAY TO MAKE" 

PRINT" TOLL CALLS" 

PRINT 

INPUT"WHEN READY TO PROCEED PRESS ENTER", -X 

CLS: PRINT: PRINT 

PRINT"FUNCTIONS AVAILABLE" 



PRINT" 

PRINT" 

PRINT" 

PRINT" 

PRINT" 

PRINT" 

PRINT" 

PRINT" 

PRINT 

INPUT"TYPE THE NUMBER OF YOUR CHOICE AND ENTER",-B 

ON B GOTO 300,1600,550,800,1100,1900,1400,1500 

END 

CLS:PRINT:PRINT 



1. TO BUILD PILE OF TELEPHONE CALLS" 

2. TO CORRECT A CALL ALREADY ON THE FILE" 

3. TO LIST CALLS BY AREA CODE" 

4. TO LIST CALLS BY AREA CODE & EXCHANGE" 

5. TO LIST ALL CALLS TO ONE NUMBER" 

6. TO LIST ALL CALLS MADE ON ONE DAY" 

7. TO SAVE THE DATA FILE ON CASSETTE" 

8. TO LOAD A DATA FILE FROM CASSETTE" 



PRINT" 

PRINT" 

INPUT" 

CLS 

PRINT" 

PRINT" 

PRINT 

FOR 1=1 

INPUT" 



THIS FUNCTION IS USED TO ENTER CALLS I 
THE DATA FILE. WHEN READY TO 
ENTER CALLS PRESS ENTER" ;X 

TO CLOSE THE DATA FILE ENTER 9999 FOR 
DAY OF MONTH." 



TO 500 

DAY OF MONTH";D(I) 
IF D(I)=9999 GOTO 470 
INPUT" AREA CODE";A(I) 
INPUT" EXCHANGE";E(I) 
INPUT" NUMBER";N(I) 
INPUT" MINUTES";M(I) 
INPUT" COST",-C(I) 
CLS: NEXT I 
PRINT: PRINT 
P1 = I 

PRINT" ok - DATA FILE IS CLOSED" 

INPUT" TO SEE FUNCTIONS AVAILABLE PRESS ENTER" ;X 
GOTO 130 
END 
CLS 
PRINT" 
PRINT" 
PRINT 
PRINT" 
PRINT" 
PRINT" 
PRINT" 



THIS FUNCTION LISTS CALLS INTO ALL AREAS COVERED 
BY A WATS LINE 

A LIST OF AREAS COVERED BY THE VARIOUS WATS" 
LINES IS AVAILABLE FROM YOUR LOCAL TELEPHONE" 
COMPANY 
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630 PRINT" WHEN YOU ARE READY TO ENTER THE FIRST AREA" 

640 INPUT" CODE, PRESS ENTER",-X 

650 CLS:PRINT:PRINT 

660 INPUT" ENTER AREA CODE";F 

662 LPRINT:LPRINT:LPRINT:LPRINT:LPRINT 

663 Q=0:R=0 

664 LPRINT TAB{20) "1ISTING BY AREA CODE" 

665 GOSUB 3000 

670 FOR I = 1 TO PI 

675 IF F=A(I) GOSUB 4000 

680 IF F=A(I) Q=Q+C(I) 

685 IF F=A(I) THEN R=R+H(I) 

690 NEXT I 

695 LPRINT TAB (20) "TOTALS"; TAB (40) R;TAB(48) USING "#t#.##"-0 

700 PRINT" DO YOU HAVE ANOTHER AREA CODE TO ENTER" 

710 INPUT" YES OR NO";G$ 

720 IF G$="YES" GOTO 650 ELSE GOTO 130 

800 CLS: PRINT: PRINT 

810 PRINT" THIS FUNCTION LISTS ALL CALLS INTO ONE" 

820 PRINT" EXCHANGE. THIS FUNCTION IS USED PRIMARILY" 

840 PRINT" T ° ST " DY ™ B PEASIBILI,nr Of FOREIGN EXCHANGE" 

850 PRINT" LISTS OF EXCHANGES COVERED AND COSTS ARE" 

o™ ™™ AVAILABLE FROM YOUR LOCAL TELEPHONE COMPANY" 

o/u PRINT 

aoS ?5o™" m ™ READY T0 ENTER «"» CODE AND EXCHANGE" 

890 INPUT" NUMBERS PRESS ENTER" ;X 

900 CLS:PRINT:PRINT 

910 INPUT" ENTER AREA CODE":H 

920 CLS: PRINT 

930 INPUT" ENTER EXCHANGE", -K 

932 LPRINT:LPRINT:LPRINT:LPRINT:LPRINT 

935 CLS:Q=0:R=0 

938 LPRINT TAB ( 20) "LISTING BY AREA CODE S EXCHANGE" 

940 GOSUB 3000 

950 FOR I =1 TO PI 

960 IF H=A(I) AND K=E(I) GOSUB 4000 

964 IF H=A(I) AND K=E(I) THEN Q=Q+C(I) 

968 IF H=A(I) AND K=E(I) THEN R=R+M(I) 

970 NEXT I 

975 LPRINT TAB(20) "TOTALS" ;TAB(40 ) R;TAB(48) USING"*S# . #i" -0 

oo» ?S™£ D ° Y0U HAVE ™0™ER EXCHANGE AND AREA CODE" 

990 INPUT" YES OR N0";GS 

1000 IF G$="YES" GOTO 900 ELSE GOTO 130 

1100 CLS: PRINT: PRINT 

1110 PRINT" THIS FUNCTION LISTS ALL CALLS TO ONE" 

1120 PRINT" NUMBER AND IS USED PRIMARILY TO DECIDE" 

1130 PRINT" THE FEASIBILITY OF INSTALLING A TIE" 

1140 PRINT" LINE." 

1150 PRINT" INFORMATION AND COSTS ON TIE LINES ARE" 

1160 PRINT" AVAILABLE FROM YOUR LOCAL TELCO ." 

1170 REM 

1180 PRINT 

1190 INPUT" WHEN READY TO PROCEED PRESS ENTER":X 

1200 CLS: PRINT 

1210 INPUT" ENTER AREA CODE", -A 

1220 INPUT" ENTER EXCHANGE" ; E 

1230 INPUT" ENTER NUMBER" jN 

1235 LPRINT:LPRINT:LPRINT:LPRINT:LPRINT 

1240 CLS:Q=0:R=0 

l«a rn5, I ,S T «SS <2B, " I ' 1STING 0F ALL CflLLS T0 0NE NUMBER" 
145a GOSUB 3000 

1260 FOR 1= 1 TO PI 

1270 IF A=A(I) AND E=E(I) AND N=N(I) GOSUB 4000 

1274 IF A=A(I) AND E=E(I) AND N=N(I) THEN Q=Q+C(I) 

1278 IF A=A(I) AND E=E(I) AND N=N(I) THEN R=R+M I 

1280 NEXT I 

}28S LPRINT TAB(20)"TOTALS";TAB(40)R;TAB(48)USING "}S8.SJ";Q 

1290 PRINT" DO YOU HAVE ANOTHER NUMBER TO ENTER" 

1300 INPUT" YES OR N0";G$ 

1310 IF G$="YES" GOTO 1200 ELSE GOTO 130 

1400 REM 

1410 CLS 

J? 2 « JH U ^ mEN ™ E CASSETTE RECORDER IS READY PRESS ENTER", -X 
H32 C r?ot?-i!p1 RINT:PMNT " N ° W REC0RWNG EILE ONTO CASSETTE" 

1435 FOR I=1T0P1 

1440 PRINT#-1,D(I),A(I),E(I),N(I),M(I),C(I) 

1450 NEXT I 

1460 CLS:PRINT:PRINT 

Hit ?5™ RECORDING NOW COMPLETE TO SEE FUNCTIONS" 

1480 INPUT" PRESS ENTER" ;X 

1490 GOTO 130 

1500 CLS: INPUT" WHEN CASSETTE IS READY PRESS ENTER",-X 

15B3 ?NPU«!?™r £ ' RIm " N0 " l ° ADING " LE FR 0» CASSETTE" 

1505 FOR I=1T0P1 
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1510 INPUTt-l,DiI),A(I),E(I),N(I),M(I),C(I) 

1520 NEXT I 

1530 PRINT: PRINT 

1540 PRINT" LOADING NOW COMPLETE - TO SEE FUNCTIONS" 

1550 INPUT" AVAILABLE PRESS ENTER" ;X 

1560 GOTO 130 

1600 CLS:PRINT" ENTER THE INFORMATION FOR THE CHECK TO BE CORRECTED" 

1610 PRINT: INPUT" DAY OF MONTH" ;D 

1620 INPUT" AREA CODE"; A 

1630 INPUT" EXCHANGE" ;E 

1640 INPUT" NUMBER" ;N 

1650 INPUT" MINUTES", -M 

1660 INPUT" COST";C 

1670 FORI=lTOPl 

1680 IFD=D(I) AND A=A(I) AND E=E(I) AND N=N(I) AND M=M(I) AND C=C(I) GOTO 1740 

1690 NEXT I 

1700 PRINT" CHECK NOT FOUND IN FILE" 

1710 INPUT" TO TRY AGAIN ENTER YES - TO SEE FUNCTIONS AVAILABLE ENTER NO";G$ 

1720 IFC$="YES" GOTO 1600 ELSE GOTO 130 

1730 REM 

1740 CLS:GOSUB3000 

1750 GOSUB4000 

1760 PRINT" ABOVE IS THE CHECK AS IT APPEARS BEFORE CORRECTION" 

1770 PRINT: PRINT " ENTER THE CORREDTED INFORMATION" 

1780 INPUT" DAY OF MONTH";D(I) 

17 90 INPUT" AREA CODE";A(I) 

1800 INPUT" EXCHANGE";E(I) 

1810 INPUT" NUMBER";N(I) 

1820 INPUT" MINUTES";M(I) 

1830 INPUT" COST";C(I) 

1840 PRINT" THE CORRECTED CHECK NOW READS" :PRINT 

1650 GOSUB4000 

1860 PRINT" DO YOU HAVE ANOTHER CHECK TO ENTER" 

1870 INPUT" YES OR NO";G$ 

1880 IF G$="YES" GOTO- 1600 ELSE GOTO 130 

1900 CLS: PRINT: PRINT 

1910 PRINT" TO LIST ALL CALLS MADE ON ONE DAY" 

1920 PRINT" ENTER THE DAY OF THE MONTH YOU" 

1930 INPUT" WOULD LIKE TO SEE";D 

1935 LPRINT: LPRINT: LPRINT: LPRINT: LPRINT 

1940 CLS:Q=0:R=0 

1945 LPRINT TAB(20)" LIST OF ALL CALLS MADE ON ONE DAY" 

1950 GOSUB 3000 

1960 FOR I = 1 TO PI 

1970 IF D=D(I) GOSUB 4000 

1974 IF D=D(I) THEN Q=Q+C<I) 

1978 IF D=D(I) THEN R=R+M(I) 

1980 NEXT I 

1985 LPRINT TAB( 20) "TOTALS" ;TAB(40) R;TAB(48) USING"#S# . II" ;Q 

1990 PRINT: PRINT 

2000 PRINT" DO YOU HAVE ANOTHER DATE TO ENTER" 

2010 INPUT" YES OR NO";G$ 

2020 IF GS="YES" GOTO 1900 ELSE GOTO 130 

3000 LPRINT:LPRINT:LPRINT TAB(10) "DAY";TAB(38) "NUMBER";TAB(48) "COST" 

3010 LPRINT TAB(10)"OF";TAB(16)"AREA";TAB(41)"OF";TAB(49)"OF" 

3020 LPRINT TAB(9)"MONTH";TAB(16)"CODE";TAB(21)"EXCHANGE";TAB(30)"NUMBER";TAB(39 

)"MINS";TAB(48)"CALL" 

3030 LPRINT" " 

3040 RETURN 

4000 LPRINT TAB(10)D(I);TAB(17)A(I);TAB(23)E(I);TAB(30)N(I) ,-TAB ( 40 ) M( I) ;TAB(48) 

USING "ll#.*#";C(I) 
4010 RETURN 
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STOCK MARKET PORTFOLIO EVALUATION: by A.S. Turner 



Keep track of the profit and 
loss of that portfolio with this 
program. Value, income and 
earnings are considered in the 
evaluation of each investment. 
Buy low, sell high. 



stock mn fwrrttio 'cwumioi mem 

type i wona mite ra rnami m m nixs 
»4«ibiiHsKi/iaBtiaifiWiMtfc5*siin}e( 

type camm? m 
,,,vtfljJ0lJDm>JMMJMMWJ-. 

N0.JF 96.' IB 

HIV./SH.' 83 

STK. HtlCP IS' 

OBI./SI.' 85 

EABilNG PKIOB-WKTHS? 



TYPE 1 TO OfSS K«fe2 rtJR PSIKICVtt3 TO MWFiLES 

:« to iHSEET/Kuicamm imai .s'ra'som - . •■"• 



100 •*«** STOCK MARKET PORTFOLIO EVALUATION PROGRAM **** 

101 ■ 

103 'REQUIRES TRS-80 WITH 16K, LEVEL II, LINE PRINTER 

104 'PROVIDES PORTFOLIO VALUE, INCOME, AVERAGE YIELD 

105 'ALSO YIELD AND P/E RATIO FOR UP TO 40 SECURITIES 

106 'CASSETTE TAPE STORAGE OF DATA 

107 ' 

120 'K= NUMBER OF COMPANY NAMES ENTERED 

121 DEFINT I,J,K,L,N,Q,S:DEFSTR A,B:DEFDBL M,T 

122 CLEAR 4000:K=1 

124 DIM S(40),D(40),P(40),E(40),MO(40) 

125 DIM AS (40) 

126 DIM TXT? (40) 

127 LET CS="###,»#*.*#":DS="S#.#" 

128 LET E$="*88S«SS":FS="SSS5S8" 

129 CLS:PRINT873, "STOCK MARKET PORTFOLIO EVALUATION PROGRAM" 

130 PRINT:PRINT "TYPE 1 TO ENTER DATA, 2 FOR PRINTOUT.3 FOR DATA FILES" 
135 INPUT"4 TO INSERT/DELETE COMPANY DATA, 5 TO SORT";J 

140 ON J GOTO 170,600,1000,3000,3600 
170 PRINT:PRINT:PRINT "SELECT DATA TO BE ENTERED" 
180 PRINT "TYPE 1 FOR COMPANY NAME, 2 FOR NO. OF SHS." 

190 INPUT "3 FOR DIV/SH, 4 FOR STK PRICE, 5 FOR NAME/DATE, 6 FOR EARN ./SH. " : I 
200 ON I GOTO 2000,300,400,500,1400,1700 
300 FOR N=l TO K 
310 PRINT AS(N) 

320 INPUT "NO. OF SHARES",-S (N) 
330 NEXT N 
340 GOTO 130 
400 FOR N=l TO K 
410 PRINT A$(N) 
420 INPUT "DIV/SHARE";D(N) 
430 NEXT N 
440 GOTO 130 
500 FOR N=l TO K 
510 PRINT AS(N) 
520 INPUT "STOCK PRICE";P(N) 
530 NEXT N 
540 GOTO 130 

600 PRINT " ":PRINT "CHOOSE WHAT PRINTOUT" 

610 INPUT "TYPE 1 FOR PORTFOLIO VALUE, 2 FOR INCOME, 3 FOR EARNINGS"; J 
620 ON J GOTO 640,800,1800 

640 CLS:LPRINT"PORTFOLIO OF: ";N$:LPRINT CHRS (138) :LPRINT "DATE",B$:LPRINT CHRS 
(138) 

650 LPRINT "COMPANY", "NO. OF SHS.", "STK. PRICE" , "VALUE" , "P/E (MONTHS) ", "DIV/SH % 

651 LPRINT CHRS (138) 
670 FOR N=l TO K 

675 IF A5(N)="»" THEN 720 

680 LPRINT AS(N), 

681 LPRINT USING ES;S(N); 

682 LPRINT TAB(30) ; 

685 LPRINT USING CS;P(N); 
687 LPRINT TAB(46) ; 

689 LPRINT USING CS;P(N) *S(N) ; 

690 IF E(N)=0 OR MO(N)=0 THEN LPRINT TAB(63) STRINGS (11 ,32) ;: GOTO 695 

691 LPRINT TAB(63) CHRS (32) ; :LPRINT USING DS;P(N)/(E(N) *12/MO(N) ) ; :LPRINT USING 

F$;MO(N) ; 



182 



695 LPRINT TAB(63) ; :LPRINT STRING?<8,32) ; :LPRINT USING D?;100*D(N)/P(N) 

696 NEXT N 
720 T=0:M-0 

730 FOR N-l TO K 

740 T=T+S(N)*P(N) :M=M+S(N)*D(N) 

750 NEXT N 

760 LPRINT CHRSU38) :LPRINT " "," "."TOTAL"; 

762 LPRINT TAB(46) J 

764 LPRINT USING CS;T; 

765 LPRINT TAB(62) STRING? (9,32) ; "AVG YIELD ";:LPRINT USING D$;100*H/T 

766 LPRINT STRINGS (4,138) 
770 GOTO 130 

800 CLS:LPRINT"PORTFOLIO OF: ";N$:LPRINT CHR$ (138) :LPRINT "DATE",B$:LPRINT CHR$ 

(138) 
810 LPRINT "COMPANY", "NO. OF SHS." ,"DIV. ", "INCOME" :LPRINT CHR$(138) 
830 FOR N=l TO K 
835 IF A?(N)="#" THEN 880 

840 LPRINT AS(N) , 

841 LPRINT USING E$;S(N); 

842 LPRINT TAB(26); 

843 LPRINT USING C$;D(N); 
845 LPRINT TAB(46) ,- 

847 LPRINT USING C?;S(N)*D(N) 

870 NEXT N 

880 M=0 

890 FOR N=l TO K 

900 M=M+S(N)*D(N) 

910 NEXT N 

920 LPRINT CHR$(138) :LPRINT " »," ", "TOTAL"; 

922 LPRINT TAB (46) 

925 LPRINT USING C$;M:LPRINT STRING? (4,138) 

930 GOTO 130 

1000 PRINT: INPUT "TYPE 1 TO READ DATA FILES, 2 TO RECORD, 3 TO VERIFY";Q 

1010 ON Q GOTO 1030,1200,1500 

1030 PRINT: PRINT "TO READ DATA FILES FROM CASSETTE" 

1040 PRINT "POSITION TAPE AND PRESS PLAY" 

1050 INPUT "PRESS ENTER WHEN READY";Z$ 

1055 INPUT #-l,N?,B$,K 

1060 FOR N=l TO K 

1070 INPUT 1-1, A?(N) 

1071 INPUT #-l,S(N),D(N),P(N) ,E(N) ,MO(N) 

1072 PRINT N 
1080 NEXT N 

1090 INPUT#-1, A?(K+1) 

1100 PRINT "DATA READ" 

1110 GOTO 130 

1200 PRINT:PRINT "TO RECORD DATA FILES ON CASSETTE" 

1210 PRINT "POSITION TAPE AND PRESS RECORD/PLAY" 

1220 INPUT "PRESS ENTER WHEN READY";Z? 

1225 PRINT #-l,N?, B?,K 

1226 PRINT "B$=";B?;" K=";K 
1230 FOR N=l TO K 

1240 PRINT #-1, A?(N) 

1241 PRINT #-l,S(N) ,D(N),P(N) ,E(N) ,MO(N) 
1250 PRINT "S(";N;")=";S(N) 

1260 NEXT N 

1270 PRINT#-1,A?(K+1) 

1290 PRINT "DATA RECORDED" 

1300 GOTO 130 

1400 INPUT"NAME";N?: INPUT "DATE";B? 

1410 GOTO 130 

1500 PRINT :PRINT"TO VERIFY DATA RECORDED ON CASSETTE" 

1510 PRINT"POSITION TAPE AND PRESS PLAY" 

1520 INPUT"PRESS ENTER WHEN READY";Z? 

1525 INPUT #-l,NT?,BT?,KT 

1526 IF BT?=B? AND KT=K AND NTS=N? THEN 1530 ELSE 1600 
1530 FOR N=l TO K 

1540 INPUT #-1, AT? 

1541 INPUT i-l,ST,DT,PT,ET,MT 

1542 PRINT N 

1550 IF ATS=AS(N) AND ST=S(N) AND DT=D(N) AND PT=P(N) GOTO 1551 ELSE 1600 

1551 IF ET=E(N) AND MT=MO(N) THEN 1560 ELSE 1600 
1560 NEXT N 

1570 INPUTS-1,AT?: IF AT$="S" THEN 1590 ELSE 1600 

1590 PRINT "GOOD TAPE":GOTO 130 

1600 PRINT "BAD TAPE": GOTO 130 

1700 FOR N=l TO K:PRINT A?(N):INPUT" EARNINGS/SHARE" ;E(N) 

1710 INPUT"PERIOD— HOW MANY MONTHS" ;MO (N) 

1720 NEXT N:GOTO 130 

1800 CLS:LPRINT"PORTFOLIO OF: ";N?:LPRINT CHR? (138) :LPRINT"DATE" ,B?:LPRINT CHR? 

(138) 
1810 LPRINT"COMPANY","NO. OF SHS. " , "DIV. " , " EARN. (MONTHS) " :LPRINT CHR?(138) 
1820 FOR N=l TO K 
1830 IF A?(N)="I" THEN 1870 

1840 LPRINT A?(N) ,:LPRINT USING E?;S(N) ; :LPRINT TAB(26); 
1850 LPRINT USING C?;D(N) ;: LPRINT TAB(46) ;: LPRINT USING C?;E(N) ;: LPRINT USING F? 

;MO(N) 
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1860 NEJCT N 

1870 LPRINT STRINGS (4, 138) 

1880 GOTO 130 

2000 CLS:PRINT "ENTER COMPANY NAMES WITH # AS LAST" 

2010 K=0 

2020 FOR N=l TO 40 

2030 INPUT "COMPANY NAME";AS(N) 

2040 IF A$(N)="»" THEN 130 

2050 K=K+1 

2060 NEXT N 

2070 PRINT "NO MORE SPACE" 

2080 GOTO 130 

3000 INPUT"TYPE COMPANY NAME";NC$ 

3010 INPUT"TYPE 1 TO DELETE, 2 TO ADD, 3 TO MODIFY";J 

3020 ON J GOTO 3100,3300,3100 

3100 FOR N=l TO 40 

3110 IF A$(N)=NC5 THEN 3160 

3120 IF A$(N)="#" THEN 3140 

3130 NEXT N 

3140 PRINT "NAME NOT IN LIST" 

3150 GOTO 130 

3160 Q=N:ON J GOTO 3170,130,3500 

3170 FOR N=Q TO K-l 

3180 IF A$(N)="«" THEN 3210 

3190 A$(N)=A$(N+1):S(N)=S(N+1) :D (N) =D (N+l) : P(N) =P (N+l) :E(N)=E(N+1) : MO (N) =MO (N+l) 

:NEXT N 
3200 K=K-1:A$(K+1)="8" 
3210 GOTO 130 
3300 FOR N=l TO 40 

3310 IF A$(N)="S" THEN Q=N: K=Q:GOTO 3330 
3320 NEXT N 
3325 Q=K+1:K=Q 
3330 ' 
3340 A$(Q)=NC$:INPUT"NO. OF SHS.";S(Q) 

3350 INPUT "DIV./SH.";D(Q) : INPUT "STK. PRICE"; P(Q) : INPUT"EARN./SH . " ;E (Q) 

3351 INPUT"EARNING PERIOD— MONTHS" ; MO (Q) 
3360 A$(Q+1)="»" 

3370 GOTO 130 

3500 INPUT "NO. OF SHS.";S(Q) 

3510 INPUT "DIV./SH."; D(Q) 

3520 INPUT "STK. PRICE"; P(Q) : INPUT"EARN./SH.";E(Q) 

3530 INPUT"EARNING PERIOD—MONTHS" ; MO (Q) : GOTO 130 

3600 FOR L=l TO 40 

3605 IF A$(L)="»" THEN 3710 

3610 TA?=A$(L) :TP=P(L) :TS=S(L) :TD=D(L) :TE=E(L) :TM=MO(L) 

3620 FOR N=L+1 TO 40 

3625 IF AS(N)="«" THEN 3700 

3630 IF TA$<AS(N) THEN 3680 

3640 A?(L)=A$(N) :P(L)=P(N) :S(L)=S(N) :D(L)=D(N) :E(L)=E(N) :MO(L)=MO(N) 

3650 AS(N)=TAS:P(N)=TP;S(N)=TS:D(N)=TD:E(N)=TE:MO(N)=TM 

3660 TAS=A$(L) :TP=P(L) :TS=S(L) :TD=D(L) :TE=E(L) :TM=MO(L) 

3680 NEXT N 

3700 NEXT L 

3710 GOTO 130 
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PITCHING ANALYSIS: by J.E. Wells 



We all agree that Baseball is 
firmly founded in statistics. This 
pitching analysis program is 
designed to be the foundation of 
a record-keeping system for any 
serious amateur team. Keep 
track of your best hurlers, ERA, 
IP, hits and performance against 
the opposition through the long 
season. Knuckleballers included, 
too. 
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20 REM 

30 CLEAR500:NW=0:NP=0 

40 DIMDG?(40),OP$(40),LC$(40),TI(40),ER(40),DC$(40),NNS(6) ,HT(40) 

50 CLS: PRINT-PITCHING ANALYSIS PROGRAM": PRINT 

60 PRINT-OPTIONS:": PRINT" 1 - START NEW DATA FILE" 

70 PRINT" 2 - OPEN EXISTING DATA FILE" 

80 INPUT"SELECTION";A 

90 ONAGOTO200,500 

100 PRINT" ANSWER 1 OR 2 ":GOTO80 

200 REM START NEW DATA FILE 

210 CLS: INPUT-PITCHER'S NAME";NH$ 

220 INPUT-PITCHER'S TEAM";TM$ 

225 INPUT"ACE (YES OR NO)";AC$ 

226 IFLEFT$(AC$,1)="Y"THENACS="YES":GOTO230 

227 IFLEFT$(AC$,1)="N"THENAC$="NO":GOTO230 

228 GOT0225 

230 INPUT-HAND (RIGHT OR LEFT)";HD$ 

240 IFLEFTS(HD$,1)="L"THENHDS="LEFT":GOTO260 

245 IFLEFT$(HD$,1)="R"THENHD$="RIGHT":GOTO26 

250 GOTO230 

260 NG=0:GOTO1000 

500 REM OPEN EXISTING DATA FILE 

510 CLS:PRINT"INSERT DATA CASSETTE AND PRESS 'PLAY'." 

520 INPUT"PRESS 'ENTER' TO CONTINUE ";A$ 

530 INPUT#-1,NG,NM?,TM$,HD$,AR,WN,LS,AC$ 

540 FORI=lTONG 

550 INPUTJ-1,DG$(I) ,OP$(I),LC$(I),HT(I),TI(I),ER(I) ,DC$(I) 

56 NEXTI 

570 PRINT"DATA ENTRY COMPLETE." 

580 INPUT'TURN OFF RECORDER AND HIT 'ENTER' TO CONTINUE ";A 

590 PRINT 

600 GOTO1020 

1000 REM MENU 

1010 CLS 

1020 PRINT-OPTIONS: - 

LIST CURRENT DATA- 
CHANGE CURRENT DATA- 
DELETE CURRENT DATA- 
INPUT NEW DATA- 
ANALYZE DATA" 
ANOTHER PITCHER- 
END PROGRAM" 

1100 INPUT-SELECTION", -A 

1110 IFA<10RA>7THENPRINT" SELECT A NUMBER BETWEEN 1 AND 7 

1120 ONAGOSUB2000, 4200, 5000, 3000, 6000, 1150, 10000 

1140 GOTO1010 

1150 NP=1:GOTO9000 

2000 REM LIST CURRENT DATA 

2005 Al$="#t#.##" 

2010 L=0:CLS:N2=0:N1=1 
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2020 PRINT"PITCHER: 
2030 PRINT" TEAM: 
2032 PRINTUSINGA1$;AR 
2034 PRINTTAB(50);" HAND: 
2040 PRINT 
2050 PRINT" NO. "; TAB (7 ); "DATE", -TAB (15) 
);"IP";TAB(49) ; "ER";TAB(56) ;"DEC" 



NM$;TAB(35);" 
TM$;TAB(35);" 



",-HDS 



W-L: 
ERA: 



';WN;--";LS;TAB(50);" ACE: ";AC$ 



-OPP";TAB(23);"LOC";TAB(32);"HITS";TAB(41 
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2070 FORI=N1TON1+10+N2 

2080 PRINTI;TAB(7) iDGS(I) ;TAB<15) ;0P$ (I) ;TAB(23) jLCS (I) ;TAB(32) ;HT(I) ;TAB(40) ;TI 

(I) ;TAB(48) ;ER(I) ,-TAB(56) jDCS(I) 
2100 IFI=NGTHEN2140 
2110 NEXTI 
2120 GOSUB11000 
2130 N2=3:N1=I:CLS:GOTO2050 
2140 GOSUBU000 
2150 RETURN 

3000 REM INPUT NEW DATA 
3010 CLS 

3020 FORI=NG+1TO40 

3030 INPUT"DATE OF GAME (MM/DD) " ;DGS (I) 
3040 IFDGS(D="END"ORDGS(I)=""THEN3180 
3050 INPUT"OPPOSING TEAM (XXXX) " ;OP$ (I) 

3060 IFLEN(0PS(D)>40RLEN(0P?(I))<1THENPRINT" 1-4 LETTERS PLEASE ":GOT03 

050 
3070 INPUT"LOCATION (HOME OR AWAY) " ;LC$ (I) 
307 2 IFLEFTS (LC$ (I) , 1) ="H"THENLCS (I) ="HOME" :GOTO3080 
307 4 IFLEFTS (LCS (I) , 1) ="A"THENLCS (I) ="AWAY" :GOTO3080 

3076 PRINT" USE 'HOME' OR 'AWAY' ":GOTO3070 

3080 INPUT"HITS GIVEN UP°;HT(I) 

3082 IFHT(I)>10.THENINPUT"GREATER THAN 10 HITS (YES OR NO) " ;AS : IFLEFTS (A$ ,1) = "Y" 

THEN3090:IFLEFTS(AS,1)="N"THEN3080:PRINT" YES OR NO ":GOTO3082 

3090 INPUT" INNINGS PITCHED (X.XX) " ;TI (I) 

3100 IFTI(I)>10.THENINPUT"GREATER THEN 10 INNINGS (YES OR NO) "; AS : IFLEFTS (AS , 1) = 

"Y"THEN3110:IFLEFTS(AS,1)="N"THEN3090:PRINT" YES OR NO ":GOTO3100 

3110 INPUT'EARNED RUNS";ER(I) 

3120 IFER(I)>10.THENINPUT"GREATER THAN 10 EARNED RUNS" ; AS : IFLEFTS (AS , 1 ) ="Y"THEN3 

130:IFL£FTS(AS,1)="N"THEN3110:PRINT" YES OR NO ":GOTO3120 

3130 INPUT"DECISION (W, L, OR N)";DC$(I) 

3140 IFLEFT? (DC? (I) , 1) ="W"THENDC? (I) ="WIN" :GOTO3160 

3145 IFLEFT? (DC? (I) , 1) ="L"THENDC? (I) ="LOSS" :GOTO3160 

3147 IFLEFT?(DC?(I),1)="N"THENDC?(I)=" ":GOTO3160 

3150 PRINT"USE 'W' FOR WIN, 'L' FOR LOSS, OR 'N' FOR NO DECISIONl " :GOTO3130 

3160 IFI=40THENPRINT" MATRIX FULL ": 1=1+1 :NW=1 :GOTO3180 

317 NW=1: NEXTI 

3180 NG=I-1 

3190 GOSUB11500 

3200 GOSUB12000 

3210 GOTO1000 

4200 CLS 

4210 PRINT"DATA CHANGE OPTION:" 

PITCHER'S NAME" 

TEAM'S NAME" 

HAND" 

ACE" 

INDIVIDUAL GAME DATA" 

LIST GAMES" 

END CHANGE ROUTINE" 
4260 INPUT"SELECTION";A 
4270 ONAGOTO4300, 4400, 4500, 4550, 4600, 4890, 4880 

4280 PRINT" SELECT A NUMBER BETWEEN 1 AND 7 ":GOTO4260 

4300 CLS 

4310 PRINT'CURRENT NAME: ";NMS 

4320 INPUT" NEW NAME: ";NM?:NW=1 

4330 GOTO4200 

4400 CLS 

4410 PRINT'CURRENT TEAM: ";TM? 

4420 INPUT" NEW TEAM: ";TM?:NW=1 

4430 GOTO4200 

4500 CLS 

4510 PRINT"CURRENT HAND: ";HD? 

4520 INPUT" NEW HAND: ";HD?:NW=1 

4522 IFLEFT? (HD?,1)="L"THENHD?="LEFT":GOTO4200 

4524 IFLEFTS (HD? , 1) ="R"THENHD?="RIGHT" :GOTO4200 

4525 PRINT" USE 'RIGHT' OR 'LEFT' HAND ONLY ":GOTO4520 

4526 GOTO4510 
4550 CLS 

4560 PRINT"CURRENT ACE: ";ACS 

4570 INPUT" NEW ACE: ";AC?:NW=1 

4575 IFLEFTS (AC?, 1 ) ="Y"THENAC?="YES" :GOTO4200 

4580 IFLEFTS (ACS, 1) ="N"THENAC?="NO" :GOTO4200 

4582 PRINT" YES OR NO ":GOTO4570 

4585 GOTO4560 

4600 CLS 

4610 INPUT"GAME NUMBER" ;GN 

4620 IF(GN>NG)OR(GN<l)THENPRINT" GAME NUMBER OUT OF RANGE ":GOTO4610 

4630 INPUT"CHANGE DATE",-AS 

4640 IFLEFT? (A?, 1 ) ="N"ORA?=""THEN4670 

4650 PRINT"CURRENT DATE: ";DG?(GN) 

4660 INPUT"CHANGE TO : ";DG? (GN) :NW=1: A?="N" 

4670 INPUT"CHANGE OPPONENT"; AS 

46 80 IFLEFTS! AS, 1)="N"ORAS=""THEN4710 

4690 PRINT"CURRENT OPPONENT: ";OPS(GN) 

4700 INPUT"CHANGE TO : " ;OPS (GN) :NW=1 : A$="N" 
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4705 IFLEN(0PS(GN))>40RLEN(0PS(GN) X1THENPRINT" 1-4 LETTERS PLEASE ":GOT 

04700 
4710 INPUT-CHANGE LOCATION" ;A$ 
4720 IFLEFTS (AS, l)="N"ORA$=""THEN4745 
4730 PRINT"CURRENT LOCATION: n ;LC$(GN) 

4740 INPUT"CHANGE TO : " ;LCS (GN) :NW=1: A$="N" 

4741 IFLEFTS (LCS(GN) ,1) ="H"THENLCS(GN) ="HOME" :GOT04745 

4742 IFLEFT$ (LC$ (GN) ,1) ="A"THENLC$ (GN) ="AWAY" :GOT04745 

4743 PRINT" USE 'HOME' OR 'AWAY' ":GOTO4740 

4745 INPUT"CHANGE HITS GIVEN UP";AS 

4746 IFLEFTS ( AS, l)="N"ORA$=""THEN47 50 

4747 PRINT"CURRENT HITS GIVEN UP: ";HT(GN) 

4748 INPUT"CHANGE : ";HT(GN) :NW=1:AS="N" 

4749 IFHT(GN)>10.THENINPUT"GREATER THAN 10 HITS" ;A$ : IFLEFT$ (AS ,1) ="Y"THEN4750 : IF 
LEFTS(A$,1)="N"THEN4745:PRINT" YES OR NO ":GOT04749 

4750 INPUT"CHANGE INNINGS PITCHED";AS 
4760 IFLEFTS (AS, l)="N"ORAS=""THEN47 90 

4770 PRINT"CURRENT INNINGS PITCHED: ";TI(GN) 

4780 INPUT"CHANGE TO : " ;TI (GN) :NW=1 : AS="N" 

4783 IFTI(GN)>10.THENINPUT"GREATER THAN 10 INNINGS" , -AS : IFLEFTS (AS ,1) ="Y"THEN4785 

: IFLEFTS (AS, 1>="N"THEN47 80: PRINT" YES OR NO ":GOT04783 

4785 GOSUB11500 

4790 INPUT'CHANGE EARNED RUNS";AS 

4800 IFLEFTS (AS, 1)="N"ORAS=""THEN4830 

4810 PRINT"CURRENT EARNED RUNS: ";ER(GN) 

4820 INPUT"CHANGE TO : ";ER(GN) :NW=1:AS="N" 

4823 IFER(GN)>10.THENINPUT"GREATER THAN 10 EARNED RUNS" ;AS : IFLEFTS (AS, 1 ) ="Y"THEN 

4825:IFLEFTS(AS/1)="N"THEN4B20:PRINT" YES OR NO ":GOT04823 

4825 GOSUB11500 

4830 INPUT'CHANGE DECISION";AS 

4840 IFLEFTS (AS, 1)="N"ORAS=""THEN4870 

4850 PRINT"CURRENT DECISION: ";DC$(GN) 

4860 INPUT'CHANGE TO : " ;DCS (GN) :NW=1:A$="N" 

4861 IFLEFTS (DCS (GN) ,1) ="W"THENDCS (GN) ="WIN" :G0TO4865 

4862 IFLEFTS (DCS (GN) , 1 ) ="L"THENDCS (GN) ="LOSS" :GOT04865 

4863 IFLEFTS (DCS (GN) ,1) ="N"THENDCS (GN) =" " :GOT04865 

4864 PRINT" USE 'W FOR WIN, 'L' FOR LOSS, OR 'N' FOR NO DECISION ":G0T0 

4860 

4865 GOSUB12000 
4870 GOTO4200 
4880 RETURN 
4890 GOSUB2000 
4900 GOTO4200 

5000 REM DELETE CURRENT DATA 

5010 CLS 

5020 PRINT'OPTION:" 

5030 PRINT" 1 - LIST GAMES" 

5040 PRINT" 2 - DELETE DATA" 

5050 PRINT" 3 - END DELETE ROUTINE" 

5060 INPUT"SELECTION";A 

5070 ONAGOTO5100, 5200, 5090 

5080 PRINT" SELECT 1, 2, OR 3 ":GOTO5060 

5090 RETURN 

5100 GOSUB2000 

5110 GOTO5000 

5200 CLS 

5210 PRINT: INPUT "GAME NUMBER TO BE DELETED" ;GN 

5220 IFGN>NG0RGN<1THENPRINT: PRINT" GAME NUMBER OUT OF RANGE ":GOTO5210 

5230 PRINT:PRINT"GAME NUMBER ";GN 

5240 PRINT'GAME DATE ";DGS(GN) 

5250 PRINT"OPPOSING TEAM .. "[OPS(GN) 

5260 PRINT"LOCATION ";LCS(GN) 

5270 PRINT'HITS GIVEN UP .. ";HT(GN) 
5280 PRINT'INNINGS PITCHED ";TI(GN) 

5290 PRINT"EARNED RUNS ";ER(GN) 

5300 PRINT'DECISION ";DCS(GN) 

5310 PRINT: INPUT"IS THIS THE GAME TO BE DELETED";AS 
5320 IFLEFTS (AS, 1) ="Y"THEN5350 
5330 IFLEFTS(AS,1)="N"THEN5010 

5340 PRINT"- TYPE 'YES' OR 'NO' ":GOTO5310 

5350 NG=NG-1:NW=1 

5355 IFNG=0THENPRINT"MUST BE MORE THAN ONE DATA RECORD BEFORE DELETE CAN BE MADE 

i":GOSUB11000:GOTO5010 
5360 FORI=GNTONG 
5370 DG$(I)=DGS(I+1):0PS(I)=0PS(I+1) :LCS (I) =LCS (1+1) :HT(I) =HT(I+1) :TI (I) =TI (1+1) 

:ER(I)=ER(I+1) :DCS(I)=>DCS(I+1) 
53 80 NEXTI 
5384 GOSUB11500 
5386 GOSUB12000 
5390 GOTO5010 
6000 REM ANALYZE DATA 
6010 CLS:PRINT"DATA ANALYSIS" :PRINT 

6020 PRINT"IN ORDER TO PERFORM THIS ANALYSIS PLEASE ANSWER THE" 
6030 PRINT"FOLLOWING QUESTIONS:" 

6040 INPUT"IS GAME IN QUESTION AT 'HOME' OR 'AWAY' ";L1S 

6050 IFLEFTS (LIS, 1) ="H"THENL1S="H0ME" :GOTO6080 
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6060 IFLEFTS(L1$,1)="A"THBNL1$="AWAY":GOTO6080 

6070 PRINT" USE 'HOME' OR 'AWAY' ":GOTO6040 

6080 INPUT'OPPOSING TEAM OF GAME IN QUESTION (XXXX) "|OT$ 

6090 IFLEN(0T$)>40RLEN(0T?)<1THENPRINT" 1-4 LETTERS PLEASE ":GOTO6080 

6100 INPUT"DATE OF GAME IN QUESTION (MM,DD) ";M1,D1 

6110 IFHK10RM1>12THENPRINT" MONTH MUST BE BETWEEN 1 AND 12 ":GOTO6100 

6120 IFDK10RD1>31THENPRINT" DAY MUST BE BETWEEN 1 AND 31 ":GOTO6100 

6130 PRINT :PRINT"ANALYSIS HAS STARTED " 

6400 REM ANALYSIS TEST 1 

6410 IFLEFT$(L1S,1)<>"H"THENTS(1)=" ":GOTO6700 

6420 CT=0 

6430 IFLEFT$(AC$,1)<>"Y"THENTS(1)=" ":GOTO6700 

6440 FORI=NGT01STEP-l 

6450 IFLEFT${DC5(I) , 1) ="W"THENT? (1) =" ":GOTO6700 

6460 IFLEFT?(DCS(I) , 1) ="-"THEN6490 

6470 CT=CT+1 

6480 IFCT=2THEN6510 

6490 NEXTI 

6500 TS(1)=" ":GOTO6700 

6510 TS(1)="YES" 

6700 REM ANALYSIS TEST 2 

6710 CT=0 

6720 F0RI=NGT01STEP-1 

6730 IFCT=0ANDLEFT${DCS(I) , 1) ="-"THEN6760 

6740 IFLEFT$(DC$(I),1)="-"THENT$(2)=" ":GOTO7000 

6750 IFLEFT$(DC$(I),1)="L"THENT$<2)=" ":GOTO7000 

676 CT=CT+1 

6770 IFCT=3THEN6800 

67 80 NEXTI 

6790 TS<2)=" ":GOTO7000 

6800 TS(2)="YES" 

7000 REM ANALYSIS TEST 3 

7010 CT=0 

7020 FORI=NGT01STEP-l 

7030 IFCT=0ANDLEFT$(DCS(I) , 1) ="-"THEN7060 

7040 IFLEFT?(DCS(I),1)="-"THENT$(3>=" ":GOTO7 400 

7050 IFLEFT?(DC$(I),1)="W"THENT$(3)="— ":GOTO7 400 

7060 CT=CT+1 

7070 IFCT=3THEN7100 

7080 NEXTI 

7090 T$(3)=" °:GOTO7400 

7100 T5(3)=" NO" 

7400 REM ANALYSIS TEST 4 

7410 WX=0:LX=0 

7420 F0RI=1T0NG 

7430 IFOPS(I)OOTSTHEN7 460 

7440 IFLEFT$(DCS(I) ,1}="W"THENWX=WX+1 

7450 IFLEFT$(DCS(I) ,1)="L"THENLX=LX+1 

7460 NEXTI 

7470 IFWX+LX<2THENT?(4)=" ":GOTO7700 

7480 IFWX/(WX+LX)<.65THENT$(4)=" ":GOTO7700 

7490 T?(4)="YES" 

7700 REM ANALYSIS TEST 5 

7710 RESTORE 

7720 FORI=2T03 

7725 A1$=LEFT? (DGS (NG) , 1-1) :A2S=MIDS (DG$ (NG) , 1+1 ,LEN (DG$ (NG) ) -I) 

7730 IFMIDS(DG$(NG),I,1)="/"THENM2=VAL(A1S) :D2=VAL{A2S) :GOTO7770 

7740 NEXTI 

7750 PRINT" ERROR DETECTED ON DATE OF GAME " ;NG:GOSUB11000 

7760 GOTO1000 

7770 IFM2<1ORM2>12THEN7750 

7780 IFD2<1ORD2>31THEN7750 

7790 IFM1OM2THEN7 820 

7800 IFD1-D2>5THENT$(5)=" NO":GOTO8000 

7810 TS(5)=" ":GOTO8000 

7820 F0RI=1T012 

7830 READM3,D3 

7840 IFM3=M2THEN7860 

7850 NEXTI 

7860 IFD3-D2+D1>5THENT?(5)=" NO":GOTO8000 

7870 T$(5)=" ":GOTO8000 

7880 DATA1, 31, 2, 28, 3, 31, 4, 30, 5, 31, 6, 30, 7, 31, 8, 31, 9, 30, 10, 31, 11, 30, 12, 31 

8000 REM ANALYSIS TEST 6 

8010 H1=0:I1=0 

8020 IFHT(NG-1)<=TI(NG-1)THEN8040 

8030 IFHT(NG)>TI(NG)THENT$(6)=" NO":GOTO8400 

8040 IFER(NG-1)<=4THEN8060 

8050 IFER(NG)>4THENT$(6)=" NO" :GOTO8400 

8060 T$(6)=" " 

8400 REM DISPLAY ANALYSIS RESULTS 

8410 CLS: PRINT 

8420 PRINT"ANALYSIS RESULTS" :PRINT: PRINT 

8430 PRINT"TEST 1" ;TAB( 10) ; "TEST 2",-TAB(20) ("TEST 3" ;TAB(30) ; "TEST 4" ;TAB(40) ; "T 

EST 5";TAB(50);"TEST 6" 
8440 PRINT 
8450 FORI=1T06 
8460 PRINT" ";T$(I)j" "; 
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8478 NEXTI 

8475 GOSUB12500 

8480 GOSUB11000 

8490 GOTO1000 

9000 REM WRITE EXISTING PILE TO TAPE 

9005 IFNW=0THEN9120 

9010 CLS 

9020 IFNP=1THENPRINT"WE MUST WRITE THE CURRENT DATA ON TAPE BEFORE WE START ANOT 

HER PITCHER. ":GOTO9040 
9030 PRINT-BEFORE ENDING PROGRAM WE MUST WRITE CURRENT DATA ON TAPE." 
9040 PRINT:PRINT"INSERT DATA CASSETTE AND PRESS 'RECORD' AND 'PLAY'." 

9050 INPUT"PRESS 'ENTER' WHEN READY ";AS 

9060 PRINT#-1,NG,NM$,TMS,HD$,AR,WN,LS,ACS 

9070 FORI=lTONG 

9080 PRINT*-1,DG$(I) ,OPS(I) ,LC$ (I) ,HT(I) ,TI (I) ,ER(I) ,DCS (I) 

9090 NEXTI 

9100 PRINT"DATA TRANSFER COMPLETE" 

9110 INPUT'TURN OFF RECORDER AND PRESS 'ENTER' TO CONTINUE" ; AS 

9120 IFNP=1THEN30ELSE10100 

10000 GOTO9000 

10100 END 

11000 PRINT6977,"(HIT 'ENTER' TO CONTINUE)"; 

11010 INPUTA 

11020 RETURN 

11500 REM CALCULATE EARN RUN AVERAGE 

11510 S1=0:S2=0 

11520 FORI=lTONG 

11530 S1=S1+ER(I):S2=S2+TI(I) 

11540 NEXTI 

11545 IFS2=0THENAR=0:GOTO11560 

11550 AR=Sl/(S2/9.) 

11560 RETURN 

12000 REM CALCULATE WIN-LOSS RECORD 

12010 WN=0:LS=0 

12020 FORI=lTONG 

12030 IFLEFT$(DCS(I) , 1) ="W"THENWN=WN+1 

12040 IFLEFT$(DC$(I),1)="L"THENLS=LS+1 

12050 NEXTI 

12060 RETURN 

12500 REM ANALYSIS CONCLUSION 

12510 PRINT:PRINT:PRINT:PRINTTAB(18);"* * * CONCLUSION * * *":PRINT 

12520 FORI=1T06 

12530 IFT$(I)=" NO"THEN12600 

12540 NEXTI 

12550 F0RI=1T06 

12560 IFTS(I)="YES"THEN12590 

12570 NEXTI 

12580 PRINTTAB( 21); "NEUTRAL SITUATION" :GOTO12610 

12590 PRINTTAB(14); "PITCHER IN FAVORABLE SITUATION" :GOT0126 10 

12600 PRINTTAB(12); "PITCHER IN AN UNFAVORABLE SITUATION" 

12610 RETURN 
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FLIGHT PLAN: by Jack Adams 



This very detailed program is 
a must for the private pilot. It 
uses all pertinent data to calcu- 
late and print a flight plan. Fuel 
consumption, trip leg length, 
winds aloft, rate of climb and 
descent and more are all taken 
into account. Hard copy output 
is available to be taken along on 
the flight. 




3. OBHTIOi: 
irESTlNfflOHi 

5. ELEVMIOH: •" " -««l-- 

6. RIGHT HLTIHHB - 1' 

■';. useable run: 1 

8. run. cofiuniw < 

9. me of curat i 
le. aiffliNG fliisra: -i 

li. TO al^KE: i: 

m w uisno CH«GE m or tk move? w/ukI •■ 



10 REM - FLIGHT PLAN WRITTEN BY DR. JACK N. ADAMS, JEROME, ID. 
20 REM - JUNE 197 9 * VER 4 

30 CLEAR(1800) :H=0:X=0:B=0:R=0:K=0:M=1:RD=0.01745329:PP=896 
40 CLS:PRINTg26, "FLIGHT PLAN"; 

50 PRINT8128," 1. DATE:":PRINT" 2. STARTING POINT: " :PRINT 
4. DESTINATION:": 
PRINT" 5. 



ELEVATION :": PRINT " 



ELEVATION: ":PRINT" 6. 
INT" 7. USEABLE FUEL: " :PRINT" 
PRINT" 9. RATE OF CLIMB: ": PRINT" 



:PRINT"11. TRUE AIRSPE 



0:DAS=BAS: 



FLIGHT ALTITUDE:": PR 

. FUEL CONSUMPTION:" 

10. CLIMBING AIRSPEED:" 

ED:" 
65 GOTO 180 
70 PRINT8PP,CHR5(30) :PRINT8?P, "WHAT IS TODAY'S DATE?" ; : PL=21 :GOSUB30 

PRINT8158 , DAS ; : RETURN 
80 PRINT8PP,CHRS(30) :PRINT8PP, "WHAT IS THE STARTING POINT?" ;: PL=27 :GOSUB3000 :AS= 

BA$: PRINT8222,A$;:RETURN 
90 PRINT8PP,CHRS(30) : PRINT8PP, "WHAT IS THE ELEVATION AT " ;A$ ;"?",•: GOSUB5010 : PL=P 

D-PP-1: GOSUB3000:E1=VAL(BA$) : PRINT8286, El ;: RETURN 
100 PRINTgPP,CHR$(30) :PRINTgPP,"WHAT IS THE DESTINATION?" ;: PL=24 :GOSUB3000 : B$=BA 

$: PRINT8350,B$;:RETURN 
110 PRINTgPP,CHR$(30) :PRINTgPP,"WHAT IS THE ELEVATION AT " ;B5| ;"?";: GOSUB5010 : PL= 

PD-PP-1: GOSUB3000:E2=VAL(BA$) :PRINT8414 ,E2; :RETURN 
120 PRINTgPP,CHR$(30) :PRINT6PP, "WHAT IS THE ALTITUDE OF YOUR FLIGHT? ";PL=35:GOT 

SUB 3000: A=VAL(BA$) :PRINT8478,A;:RETURN 
130 PRINT8PP,CHR$(30):PRINT8PP,"WHAT IS YOUR USABLE FUEL?" ; : PL=25 :GOSUB3000 : 

G4=VAL(BA$) :PRINT8542,G4;:RETURN 
140 PRINTgPP,CHR$(30) :PRINT8PP, "WHAT IS YOUR FUEL CONSUMPTION RATE?" ,- : PL=35 :GOSU 

B3000: G=VAL(BA$) : PRINT8606 ,G; : RETURN 
150 PRINT8PP,CHR$(30) : PRINT8PP, "WHAT IS YOUR RATE OF CLIMB?" ;: PL=27 :GOSUB3000 : 

D=VAL(BAS):PRINT8670,D;: RETURN 
160 PRINT@PP,CHR$(30):PRINT8PP,"WHAT IS YOUR CLIMBING AIR SPEED?" ;: PL=32 :GOSUB30 

00: 0=VAL(BAS) :PRINT8734 ,0; :RETURN 
170 PRINT@PP,CHR$(30):PRINT8PP,"WHAT IS YOUR TRUE AIR SPEED?" ;: PL=28 :GOSUB3000 : 

P=VAL(BA$) :PRINT8798,P;:RETURN 
180 GOSUB70:GOSUB80:GOSUB90:GOSUB100:GOSUB110:GOSUB120:GOSUB130:GOSUB140:GOSUB15 

0: GOSUB160:GOSUB170 
190 PRINT8PP,CHR$(30):PRINTgPP,"DO YOU WISH TO CHANGE ANY OF THE ABOVE? (Y/N)";: 

GOSUB5000 : IFAB$="N"THEN350 
200 PRINT8PP,CHR$(30) :PRINT8PP, "ENTER LINE NUMBER TO BE CHANGED " ; : GOSUB5010 : PL= 

PD-PP-1:GOSUB3000:N=VAL(BAS): IFN<1ORN>11THEN200 
210 ON N GOSUB70, 80, 90, 100, 110, 120, 130, 140, 150, 160, 170 
220 GOTO190 
350 PRINT8PP,CHRS(30):PRINT8PP,"HOW MANY LEGS ON THE FLIGHT FROM ";A$;" TO ";BS; 

"?";: GOSUB5010:PL= PD-PP-1 :GOSUB3000:Q=VAL(BA$) 
370 DIM L(Q),C(Q),W(Q),V(Q),U(Q),A(Q),S(Q),F(Q) 
380 Q1=Q+1 
390 DIM SS(Q1) 
430 SS(0)=LEFT$(A$,3) 
440 PRINTgPP,CHR$(30):PRINT8PP,"DO YOU WANT A RETURN FLIGHT PLAN (Y/N) " ; : G0SUB5 

000: IFAB$="Y"THENZ=1 
460 CLS 

470 FOR N=1T0Q 

480 PRINT'LEG #";N;" *****************" 
490 PRINT'END POINT OF LEG (3 LETTERS) " ; 
500 INPUT R$ 

520 IF LEN(R$)<>3 THEN PRINT "IDENT FOR END POINT MUST HAVE 3 LETTERS" 
530 IF LEN(R?)<>3 THEN 490 
540 SS(N)=R$ 
550 PRINT"LENGTH OF LEG "; 
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560 INPUT L(N) 

570 PRINT-TRUE COURSE "; 

580 INPUT C(N):IP C(N)<0 OR C(N)>360 THEN 570 

590 C(N)=C(N)*RD 

595 IF N=l THEN 630 

600 PRINT'IS WIND DIRECTION SAME AS PREVIOUS LEG? (Y/N) " : -GOSUB5000 

610 J=0:PRINT:IF ABS="Y"THENJ=1 ' 

620 IP J=l THEN W(N)=W(N-1) .-GOTO 660 

630 PRINT'WHAT IS THE WIND DIRECTION " ; 

640 INPUT W{N) 

650 IP W(N)<0 OR W(N)>360 THEN 630 ELSE W(N)=W(N)*RD 

655 IP N=l THEN 690 

660 PRINT'IS VARIATION SAME AS PREVIOUS LEG? (Y/N) " ; : GOSUB5000 

670 J=0:PRINT:IFABS="Y"THENJ=1 

680 IF J=l THEN V(N) =V(N-1) :GOTO 720 

690 PRINT'WHAT IS THE VARIATION (ENTER EAST AS - ) " • 

700 INPUT V(N) 

710 V(N)=V(N)*RD 

715 IF N=l THEN 750 

720 PRINT'IS WIND SPEED SAME AS PREVIOUS LEG? (Y/N) " : : GOSUB5000 

730 J=0:PRINT:IFABS="Y"THENJ=1 

740 IF J=l THEN U(N) =(] (N-l) : GOTO 770 

750 PRINT'WHAT IS THE WIND SPEED ■; 

760 INPUT U(N) 

770 NEXT N 

780 PRINT:PRINT"TURN ON PRINTER AND ADJUST PAPER (PRESS ENTER WHEN READY) " ; : INPU 

880 LPRINfsTR?NGSufl3™ EN PRINT:PRINT "** PRINTER N0T READY ""'GOTO 7 80 
810 LPRINT-FLIGHT PLAN PROM ";AS;" TO ";BS 
820 LPRINT CHR$(138) 
830 LPRINT DA? 

840 LPRINT-STARTING ALTITUDE ";E1;" ENDING ALTITUDE "-E2 

850 LPRINT'TIMB TO CLIMB TO ";A; sLPRINTUSING "t«#H.tt "; (A-ED/D; iLPRINT" MTN 
- TRAVELLING "; "//u,.i.«iim min. 

860 LPRINTUSING"M###.##";(A-E1)/D*(O/60);:LPRINT" MILES" 
870 LPRINT STRING$(1,138) 
880 GOSUB 1270 
890 GOSUB 1310 
900 GOSUB 1270 
920 FOR N=l TO Q 
930 GOSUB 1640 
940 GOSUB 1350 
950 GOSUB 1270 
960 NEXT N 

980 GOSUB 1870:GOSUB 1900 
990 IF ZOl THEN 2060 
1000 LPRINT STRING$(2,138) 

1010 LPRINT"FLIGHT PLAN FROM ";BS;" TO ";AS 
1020 LPRINT CHR$(138) 
1030 LPRINT DAS 

1040 LPRINT'STARTING ALTITUDE ";E2,-" ENDING ALTITUDE "-E1 

1050 LPRINT"TIME TO CLIMB TO " ; A+1000; :LPRINTUSING"##t«# '. ## ",- ( (A+1000J -E2) /D- 
1060 LPRINT" MIN. - TRAVELLING " ; : LPRINTUSING"###i# . f # "; ( ( ( A ll000) -E2y'/D) * (0/60 
);:LPRINT"MILES" ' "'/"I (U/60 

1070 LPRINT STRINGS (2,138) 
1080 B=2:H=0:R=0:K=0:X=Q:Z=9 
1090 M=l 

1100 FOR N=l TO Q 
1110 C(N)=C(N)-3. 1415927 
1120 IF C(N)<0 THEN C(N) =C(N) +6.2831853 
1130 NEXT N 
1140 GOSUB 1270 
1150 GOSUB 1310 
1160 GOSUB 1270 
1180 FOR N=Q TO 1 STEP -1 
1190 GOSUB 1640 
1200 GOSUB 1350 
1210 GOSUB 1270 
1220 NEXT N 

1240 GOSUB 1870:GOSUB 1900 
1250 GOTO 2060 
127 LPRINT STRINGS (7 2, 95) 
1290 RETURN 
1310 LPRINT"LEG : STR-END : COURSE :MAGNETIC: LEG LEN :USEABLE : TIME : GR 

1320 LPRINT" : : . COURSE = : FUEL = (T. TIME) . S p 

1330 RETURN 

1350 LPRINT" : : : . . . ... 

LPRIN ' ' ' 

TUSING"»» ";B7;B8;B9;:LPRINT" :" 
1360 RETURN 
1380 LPRINT" : "; 
1390 RETURN 
1410 W=W(N)+V(N) 
1420 REM - CALC. MAGNETIC COURSE 
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1430 X1=((U(N)/P)*SIN(W-C(N))) 

1440 A<H)=C(N)+2*ATN(X1/(1+SQR(1-X1*X1))) 

1460 S(N)=ABS(P*COS(A(N)-C(N))-U(N)*COS(W-C(N))) 

1470 A(N)=A(N)/RD 

1480 IF A(N)<=0 THEN A (N) =A(N) +360 

1490 IF A(N)>360 THEN A(N) =A(N) -360 

1500 IF M=l THEN 2030 

1510 T=L(N)/S(N) 

1520 R=R+T 

1530 E7=INT(T) :E8=INT((T-E7)*60) :E9=INT ( ( ( (T-E7) *60 ) -E8) *60) 

1540 K=K+L(N) 

1560 F(N)=T*G 

1570 H=H+F(N) 

1580 IF Z = 9 THEN 1970 

1590 IF N=l THEN F (N) =G4-F (N) :G0TO 1620 

1600 IF F(N-1)-F(N)<=0 THEN LPRINT"CAUTION - - STOP FOR FUEL!" 

1610 IF F(N-1)~F(N)<=0 THEN F(N)=G4-F(N) ELSE F (N) =F (N-l) -F(N) 

1620 RETURN 

1640 GOSUB 1410 

1650 LPRINTUSING"###";M; 

1660 H=H+1 

1670 GOSUB 1380 

1680 IF B=0 THEN LPRINTSS (X) ; "-" ;S$ (X+l) ; ELSE LPRINTS$ (X) ; "-" ;S$ (X-l) ; 

1690 IF B=0 THEN X=X+1 ELSE X=X-1 

1700 GOSUB 1380 

1710 LPRINT USING"#»S###";C(N)/RD; 

1720 GOSUB 1380 

1760 LPRINT USING"JSS##S";A(N) ; 

1770 GOSUB 1380 

1780 LPRINT USING"8#f»#t#";L(N); 

17 90 GOSUB 1380 

1800 LPRINT USING"tt##.t";F(N); 

1810 GOSUB 1380 

1820 LPRINT USING" S»" ;E7 ;E8;E9; :LPRINT" "; 

1830 GOSUB1380 

1840 LPRINT USING"#S*#»«";S(N) 

1850 GOSUB 1870:RETURN 

1870 B7=INT(R) 

1880 B8=INT((R-B7)*60) 

1890 B9=INT((((R-B7)*60)-B8)*60) :RETURN 

1910 LPRINT"TOTAL TIME = " ;B7 ; " : " ;B8; " ' " ;B9; " FUEL USED = ";:LPRINT USING"##8» 

.#i";H; 
1920 LPRINT" DISTANCE = ";:LPRINT USING" tf ##.##" ;K 
1930 LPRINT"AVERAGE GROUND SPEED = ";:LPRINT USING" SSSS . SS" ; K/R 
1940 LPRINT STRING$(5,138) 
1950 RETURN 

1970 IF N=Q THEN F(N)=G4-F(N) : GOTO 1620 

1980 IF F(N+1)-F(N)<=0 THEN PRINT "CAUTION - - STOP FOR FUEL I " 
1990 IF F(N+1)-F(N)<=0 THEN F(N)=G4-F(N) ELSE F (N) =F(N+1) -F (N) 
2000 GOTO 1620 

2030 IF N=l THEN T= (L(N) +(2* (A-ED/1000 ) )/S (N) :GOTO 1520 
2040 IF SOI THE T= (L(N) + (2* < (A+1000) -E21/1000) )/S (N) :GOTO 1520 
2060 LPRINTCHRSU2) :CLS 
2070 PRINT'HAVE A GOOD FLIGHT1" 
2080 END 

3000 PRINTCHR$(14);:BA$="" 
3010 AB$=INKEYS:IFAB$=""THEN3010 

3020 IFAB$=CHR$(13)THEN PRINTCHR? (15 ) :RETURN „„„,„,„ 

3030 IFAB$=CHR$(8)THENIFBA$O""THENPRINTAB$;:BA$=LEFT$(BA$,LEN(BA$)-1):GOTO3010: 

ELSEGOTO4010 
3040 IFAB$=CHR$(24)THENPRINTCHRS(29);STRING$(PL,CHR$(25));CHR$(30);:GOTO3000 

3050 PRINTAB$;:BA$=BA$+AB$:GOTO3010 

4000 ABS="" 

4010 PRINT6PD,CHRS(143);:L=1 

4020 ABS=INKEYS : IFABS< > " "THENPRINT8PD , ABS ; : RETURN 

4030 L=L+1:IFL<16THEN4020 

4040 PRINT6PD," ";:FORL=1TO10:NEXT:GOTO4010 

5000 GOSUB5010:GOSUB4000:RETURN 

5010 PD=(256*PEEK( 16417 ) +PEEK(16416) ) -15359 :RETURN 
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UTILITY 

Print Jim Perry 

Matrix Sort Routine Ross Wirth 

Peekpoke Irwin Rappaport 

Tape Save Bob Penhollow 

Data Screen Frank Myers 

Autopoke Jasper Kumpt 
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PRINT: by Jim Perry 



This lifesaving program was 
written by one of our own in an 
effort to standardize line printer 
output when listing programs 
which have been written in vary- 
ing degrees of style. The user 
may select the line length and ti- 
tle, the program does the rest. 
ASCII storage of files is required 
in this disk based program. Page 
numbering and return to direc- 
tory functions are included. 



IH)T LIME LDCffl ? 86 

wit is lie raw* mi? nam- 



10 CLEAR 1000:FILL$=" ":LC=66:PP=1 

20 CLS 

25 INPUT"WHAT LINE LENGTH ";LL 

30 INPUT"WHAT IS THE PROGRAM NAME ■; PROGRAMS 

35 GOSOB 540 

40 OPEN " I ",1, PROGRAMS 

50 REM 

60 IP EOF(l) THEN GOTO 1000 

65 IF P>56 THEN GOSUB 500 

70 LINEINPUT #1, TEMPS 

80 A=LEN (TEMPS) 

85 L1S=TEMP$ 

90 IF A <= LL THEN 200 

100 L1S=LEFTS (TEMPS, LL) 

110 L2S=RIGHTS(TEMPS,(A-LL)) 

120 B=LEN(L2S) 

130 IF B <= LL-5 THEN 200 

140 L2S=MIDS (TEMPS, LL+1, LL-5) 

142 L3S=RIGHT? (TEMPS, A-(2*LL-5)) 

143 C=LEN(L3S) 

145 IF C<=LL-5 THEN 200 

150 L3$=MIDS (TEMPS, 2*LL-4, LL-5) 

155 S=3*LL-10:IF S>=A THEN 200 

160 L4$=RIGHTS (TEMPS, A-S) 

200 LPRINT L1S:P=P+1: IF A<LL+1 THEN 50 

210 LPRINT FILLS;L2$:P=P+1: IF B<LL-4 THEN 50 

220 LPRINT FILLS;L3S:P=P+1: IF C<LL-4 THEN 50 

230 LPRINT FILLS;L4S:P=P+l:GOTO 50 

500 P=P+3:FOR I =1 TO LC-P:LPRINT:NEXT I 

530 PP=PP+1 

535 LPRINT 

540 LPRINT'PAGE 8";PP;"OF ".-PROGRAMS 

545 LPRINT"" 

550 P=0:RETURN 

1000 LPRINT:LPRINT:LPRINT 

1010 LPRINT"DONE" 

1015 LPRINT CHRSI12) 

1020 CLOSE 

1025 CMD"DIR :2" 

1030 INPUT"NEXT PROGRAM ";NS 

1040 RUN NS 
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MATRIX SORT ROUTINE: by Ross Wirth 



Have you more than one type 
of related data to be sorted? If so, 
this novel sort routine will be of 
interest to you. The routine will 
sort two-dimensional array by 
columns or rows. How? By ma- 
trix storage of data and the use of 
secondary indexes, of course. 



«SI£XTII 

4848 Nl=tl 

4858«Hl=ffl-i 
4868 IF Hl=8 MN 4168 
4878 FOR 11=1 TO 111 

IF(RC=!)«WI((((S(Il)iJX=(l(S(IW) ( J)) nth 4148 
4898 IHI!C=2)WJ((K!iS(II)K=«(!,S(IltI») 1)0) 4|4j 
4188 X=S(H) 
4118 S0I)=S(II*1) 
4138 S(II»1)=X 
' 4138 C=l 
4146 NEXT II 
4158 IF C>« DO 4858 

4iee raw 

— mil 



1000 ' MATRIX SORT SUB ROUTINE BY r.a. WIRTH PROM KB OFFICES 

4000 REM GENERALIZED ROW-COLUMN MATRIX SORT 

4010 FOR 11=1 TO N 

4020 S(II)=II 

4030 NEXT II 

4040 N1=N 

4050 C=0:N1=N1-1 

4060 IF N1=0 THEN 4160 

407 FOR 11=1 TO Nl 

4080 IF(RC=1)AND(A(S(II),J)<=A(S(IH-1),J)) THEN 4140 

4090 IF(RC=2)AND(A(I,S(II))<=A(I,S(II+1))) THEN 4140 

4100 X=S(II) 

4110 S(II)=S(II+1) 

4120 S(II+1)=X 

4130 C=l 

4140 NEXT II 

4150 IF C>0 THEN 4050 

4160 RETURN 
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PEEKPOKE: by Irwin Rappaport 



If you have ever wanted to re- 
locate a machine language pro- 
gram and wished a routine in 
BASIC was available to do it, 
your wish has been granted. This 
handy program will handle most 
of the work for you. Put those 
programs in their proper place. 




18 CLS: INPUT-START PEEK-ING";A: INPUT-STOP PEEK-ING";A1:INPUT"HIGH ORDER BYTE OP 
START ADDRESS OP ORIGINAL PROGRAM ",-Kl: INPUT-ENDING ADDRESS , AS AB0VE"jK2: 
INPUT-HIGH ORDER BYTE OF DESIRED NEW START ADDRESS" I K3 : I=K3-K1 
20 CLS:A9=118:PRINT 6 85,"* OF CHANGES"; : PRINT 8 48, "1 BYTE GROUP "i:PRINT 6 65, 

"NOW PEEK-ING": 
30 P2=0:P1=PEEK(A):IF P1=0 THEN GOSUB 1000:GOTO 30 
35 IF Pl=203 OR Pl=221 OR Pl=237 OR Pl=253 THEN 50 

40 GOSUB 300:GOSUB 1000:GOTO 30 

50 GOSUB 1000 

60 P2=PEEK(A) 

70 GOSUB 500:GOSUB 1000:GOTO 30 

300 REM *** 1 BYTE CODE GROUPS , LINES 300-400 *** 

305 REM *** SINGLE BYTE CODE ONLY *** 

310 IF Pl>=63 AND Pl<=193 THEN RETURN 

315 REM *** LOOK FOR 1 BYTE CODE £, LOAD, JUMP, OR CALL *** 

320 IF Pl=l OR Pl=17 OR Pl=33 OR Pl=34 OR Pl=42 OR Pl=49 OR Pl=50 OR P1=5B OR PI 
=194 OR Pl=195 OR Pl=196 OR Pl=202 OR Pl=204 OR Pl=205 OR Pl=210 OR Pl=212 
OR Pl=218 OR Pl=220 OR Pl=226 OR Pl=228 OR Pl=234 THEN 330 

325 IF Pl=236 OR Pl=242 OR Pl=244 OR Pl=250 OR Pl=252 THEN 330:ELSE GOTO 340 

330 GOSUB 2000:RETURN 

335 REM *** 1 BYTE CODE FOR 1 BYTE LOAD *** 

340 IF Pl=6 OR Pl=14 OR Pl=22 OR Pl=30 OR Pl=38 OR Pl=46 OR Pl=54 OR Pl=62 THEN 
350: ELSE GOTO 360 

350 GOSUB 2100:RETURN 

355 REM *** 1 BYTE + DISPLACEMENT - IGNORE AND START AGAIN *** 

360 IF Pl=16 OR Pl=24 OR Pl=32 OR Pl=40 OR Pl=48 OR Pl=56 OR Pl=198 OR Pl=206 OR 
Pl=211 OR Fl=214 OR Pl=219 OR Pl=222 OR Pl=230 OR Pl=238 OR Pl=246 OR Pl=2 
54 THEN A=A+1: RETURN 

395 REM *** DID NOT FIND ANY 1 BYTE CODE - LOOK FOR 2 BYTE »** 

400 RETURN 

500 REM *** 2 BYTE GROUPS *** 

505 REM *** CB GROUPS - IGNORE AND START AGAIN *** 

510 IF Pl=203 THEN RETURN 

520 REM *** CHECK DD GROUPS - LINES 520-580 *** 

530 IF Pl=221 THEN 540: ELSE GOTO 600 

535 REM «** IF DDCB IGNORE, SKIP NEXT 2 ADDRESSES, START AGAIN * 

540 IF P2=203 THEN A=A+2:RETURN 

545 REM *** DD 2 BYTE OP CODE, NO LOAD OR ADDRESS *** 

550 IF P2=9 OR P2=25 OR P2=35 OR P2=41 OR P2=43 OR P2=57 OR P2=225 OR P2=227 OR 
P2=229 OR P2=23 3 OR P2=24 9 THEN RETURN 

555 REM *** ADDRESSES FOLLOW THESE *** 

560 IF P2=33 OR P2=34 OR P2=42 OR P2=54 THEN 570:ELSE 580 

570 GOSUB 2000:RETURN 

575 REM *** DEFAULT LINE - MUST BE 2 BYTE OP+1 BYTE IND *** 

580 A=A+1:RETURN 

600 REM *** ED *** 

610 IF Pl=237 THEN 620:ELSE GOTO 650 

615 REM *** ED OP CODE WITH ADDRESSES TO FOLLOW *** 

620 IF P2=67 OR P2=75 OR P2=83 OR P2=91 OR P2=115 OR P2=123 THEN 630:ELSE RETURN 

630 GOSUB 2000:RETURN 

650 REM *** FD *** ^ ^ 

665 REM »** FDCB - SKIP 2 ADDRESSES AND START AGAIN *** 

670 IF P2=203 THEN A=A+2:RETURN 

675 REM *** 2 BYTE FD OP CODE - NO ADDRESS *** _ 

680 IF P2=9 OR P2=25 OR P2=35 OR P2=41 OR P2=43 OR P2=57 OR P2=225 OR P2=227 OR 
P2=229 OR P2=233 OR P2=249 THEN RETURN 

685 REM *** ADDRESSES WILL FOLLOW *** 



196 



690 IP P2=33 OR P2=34 OR P2=42 OR P2=54 THEN 700:ELSE 710 

700 GOSUB 2000:RETURN 

705 REM *** PD DEFAULT - 2 BYTE OP+1 BYTE IND *** 

710 A=A+1:RETURN 

745 REM *** SOMETHING WRONG BUT WILL CONTINUE ANYWAY! *** 

1000 REM *** UPDATE ADDRESS AND REPORT WHERE AT *** 

1010 A=A+1:IF A>A1 THEN PRINT 8 644, "CHANGES COMPLETE" ;: END: ELSE PRINT 8 129, A; 

RETURN 
1500 REM *** UPDATE AND REPORT NUMBER OP CHANGES *** 
1510 C=C+1:PRINT 8 154,C;.:RETURN 

1700 REM *** REPORT ADDRESSES OF 1 BYTE LOAD CHANGES *** 
1710 PRINT 8 A9,A;:A9=A9+64:RETURN 

2000 REM *** CHECK AND CHANGE ADDRESS IF IN RANGE *** 

2010 A=A+l:GOSUB 1000: P=PEEK{A) :IF P<K2+1 AND P>K1-1 THEN 2020:ELSE RETURN 
2020 POKE A,P+I:GOSUB 1500 

2025 REM *** THERE IS 1 DD & 1 FD WITH A 1 BYTE LOAD (DDSFD36) * 
2030 IF P2=54 THEN GOSUB 170 
2040 RETURN 

2100 REM *** 1 BYTE LOAD , CHECK AND CHANGE *** 

2110 GOSUB 1000:P=PEEK(A) :IF P<K2+1 AND P>K1-1 THEN 2120:ELSE RETURN 
2120 POKE A,P+I:GOSUB 1500:GOSUB 1700:RETURN 



TAPE SAVE: by B. Penhollow 



Don't trash those old machine 
language programs of yours just 
because you now own a TRS-80. 
Instead, save them on cassette 
and load them into your system 
with this handy program. 
CSAVE and CLOAD commands 
are used, and the secret is in the 
data statements, which contain 
short machine language steps 
that are poked into memory. 
Decimal and Hex are O.K. 



MB! M ST*T MWSS? 
BfTB! IK END «£SS? . . 
EKIDi DC MCUTIBI MSKSS? 



renKflKKaxraTOSKiicnaMi 
(to mm a diftdoi msm bub >m 



20 CLS 

30 DATA 62,0,205,18,2,205,135,2,33,0, 

60,62,85,205,100,2,6,6,126,205, 

100,2,35,16,249,17,126,80,33,0, 

§0,62.60 
40 DATA 205,100,2,6,64,120,205,100,2,14, 

0,125,205,112,80,124,205,112,80,126, 

35 , 205 , 112 , 80 , 229 , 55 , 63 , 237 , 82 , 225 , 

40,8,16,241,121 
80 DATA 205,100,2,24,214,16,2,24,7,62, 

0,205,112,80,16,251,121,205,100, 

2,62,120,205,100,2,33,0,80,125, 

205,100,2,124,205,100,2 
100 DATA 205,248,1,201,0,0,0,0,245,129, 
79,241,205,100,2,201,0,0,0,0, 
0,0,0,0 
120 REM * READ AND POKE DATA -TAPPE SAVE PROGRAM 
140 FOR X=0 TO 126 
160 READ Y:POKE 20480+X,Y:NEXT X 
180 REM * GET FILE NAME 

200 PRINT864, "ENTER PROGRAM NAME (6 CHARACTERS MAX.)' 
220 FOR X=0 TO 5 
240 AS=INKEYS:IF A$="" THEN 240 
260 PRINT80+X,AS 
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2819 NEXT X 

300 PRINT8128, "ENTER THE START ADDRESS" ; : INPUT AD$ 

320 GOSUB 1000: IF AD=0 THEN 360 

340 POKE 20509, LSB:POKE 20510, MSB:SA=MSB*256+LSB 

360 INPUT"ENTER THE END ADDRESS" ;AD$ 

380 GOSUB 1000: IF AD=0 THEN 420 ELSEIF SA>=MSB*256+LSB THEN 300 

400 POKE 20506, LSB:POKE 20507 ,MSB:AD$=" 

420 INPUT'ENTER THE EXECUTION ADDRESS" ;AD$ : IF ADS="" THEN MSB=INT(SA/256 ) :LSB=SA 

-MSB*256 ELSE GOSUB 1000 
440 POKE 20574, LSB:POKE 20575, MSB 

460 PRINTS448, "PREPARE TAPE RECORDER TO SAVE THE PROGRAM. 
(TO RECORD A DIFFERENT 

PROGRAM, ENTER 'D' )": INPUT AS: PRINT: PRINT:PRINT 
480 IF A$="D" THEN CLS:GOTO 200 
500 POKE 16526, 0:POKE 16527,80 
520 X=USR(N) :PRINT@64,:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT" ** DON 

E **" 
540 FOR X=0 TO 150:NEXT X 
560 GOTO 460 

1000 IF ADS="" THEN AD=0: RETURN ELSE AD=1 

1020 IF LEFT$(ADS,1)<>"H" THEN AD=VAL(AD$) :MSB=INT (AD/256) :LSB=AD-MSB*256 :RETURN 
1040 L=LEN(AD$):H$=MID$(AD$,L-1,L) :GOSUB 1100:LSB=D 
1060 IF L<=3 THEN MSB=0:RETURN 

1080 H$=MID$(AD$,2,L-3) :GOSUB 1100:MSB=D:RETURN 
1100 HM=ASC(LEFT$(H$,1)) :HL=ASC( RIGHT? (H$ ,1) ) 
1120 IF HM<58 THEN HM=HM-48 ELSE HM=HM-55 
1140 IF HL<58 THEN HL=HL-48 ELSE HL=HL-55 
1160 D=HM*16+HL: RETURN 
1500 FOR X=0 TO 126:PRINTPEEK(20480+X) ;" ";:NEXT X:END 



DATA SCREEN: by F.E. Myers 



This program is part of a small 
data base management system. 
It will allow you to store and 
retrieve data, update, delete, or 
correct a previous file or open a 
new file. 




put cassette m mm psess setwh ? . 



10 CLEAR 2500 

15 CLS 

20 DIM C(60),F(60),L(60),R(60) 



30 FOR 1=1 TO 7 

40 PRINT" 

50 PRINT" 

60 PRINT" 

70 FOR 1=1 TO 5 



PRINT 



: NEXT I 

DATA ENTRY SCREEN PROGRAM" 
VERSION 1.0" 
05/23/79" 
PRINT" " : NEXT I 
80 INPUT"ENTER SCREEN LINE LABELS ARE TO BEGIN (0-13) ",-Ll 
85 IF LK0 OR Ll>13 THEN 80 
90 R=L1 : C(1)=0 : C=0 : D=0 : J=l : Z=0 
100 INPUT"ENTER NUMBER OF FIELD LABELS (1-60) ";L 
110 FOR 1=1 TO L 
120 Q=254-D 
130 PRINT"LABEL ">Ij" DATA SPACE LEFT IS ";Q;" BYTES" 
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140 L2=13-R 

150 PRINT"**** nUMBER OF SCREEN LINES REMAINING IS ";L2;" ***" 

160 INPUT-ENTER SCREEN LABEL ";DS 

170 L(I)=LEN(D$) 

180 INPUT"eNTER DATA FIELD LENGTH ";F(I) 

190 G=L(I)+F{I)+4 

200 IF G>63 THEN PRINTLINE TOO LONG "jG 

210 IF G>63 THEN 160 

220 C(I)=C+64*R 

230 K=J+L(I)-1 

240 ES=E$+D$ 

250 J=K+1 

260 C=C+G 

270 IF C>63 THEN R=R+1 : C(I)=R*64 : C=G 

280 IF R>13 THEN PRINT'SCREEN FULL, LAST ENTRY IGNORED" 

290 IF R>13 THEN 350 

320 D=D+F(I) 

325 IF D>254 THEN PRINT'DATA SPACE FULL, LAST ENTRY IGNORED " 

330 IF D>254 THEN D=D-F(I) 

335 IF D>254 THEN 350 

340 Z=Z+1 

345 NEXT I 

350 REM 

500 PRINT'DATA ENTRY SCREEN WILL LOOK AS FOLLOWS" 

510 FOR 1=1 TO 500 : NEXT I 

515 CLS 

520 J=l 

530 FOR 1=1 TO Z 

540 K=J+L(I)-1 

550 X=K+1 

560 Y=X-J 

570 QS=MID$(E$,J,Y) 

575 PRINT 8C(I),Q$; 

576 J=K+1 

577 PRINT" "; 

580 FOR M=l TO F(I) 

590 PRINT"."; 

600 NEXT M 

610 NEXT I 

620 PRINT §962," "; 

630 INPUT'PUT CASSETTE ON RECORD/ PRESS RETURN ";CS 

632 CLS 

633 INPUT"eNTER DATA FILE IDENTIFYING LABEL ";JS 

634 PRINT*-1,J$ 

640 PRINT "WRITING 1ABELS TO CASSETTE " 

650 PRINT#-1,Z,E$ 

660 PRINT'WRITING LABEL AND DATA FIELD LENGTHS " 

670 FOR 1 = 1 TO Z 

680 PRINT#-1,L(I),C(I),F(I) 

690 NEXT I 

700 PRINT'END OF PROCESSING" 
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AUTOPOKE: by J.E. Kump 



Exploit your Level IPs ability 
to use speedy machine language 
routines in conjunction with 
slower BASIC routines. Auto- 
poke will allow you to write most 
of your program in BASIC and 
insert machine language routines 
to speed things up. Strings are 
used to insert the machine lan- 
guage sections, and the program 
provides for checks on the error 
prone strings. 



12FF 12 -•» 

1*8 CV 
1*1 R.' 

m a? 

1383 B5 ? 
13M CD ? FT , 

1385 if? ■;■ 

1386 99 ? - 



64000 PRINT" ALL ENTRIES IN THIS PROGRAM MUST BE IN HEXIDECIHAL NOTATION EXCE 

PT THE LINE NUMBER OF THE FIRST DATA STRING." 
64010 PRINT:PRINT"IF YOU WANT TO ENTER A NEW LINE NUMBER, ENTER X. 
IF YOU WANT T 

JUMP TO THE DATA STRING FORMAT SECTION, ENTER XXk " 
64100 PRINT: INPUT'ENTER THE ADDRESS YOU WANT TO EXAMINE OR CHANGE" ; A? :GOSUB64300 

:CLS 
64110 D=Z:GOSUB64400:PRINTHS;" ",• :D=PEEK(Z) :GOSUB64400:PRINTHS; " "; : AS="" : INPUTA 

$:IFAS=""THENZ=Z+1:GOTO64110 
64120 IFA$="X"THEN64100 
64130 IFA$="XX"THEN64200 

64140 N=Z:GOStlB64300:POKEN,Z:Z=N+l:GOTO64110 

64200 INPUT"FNTER THE FIRST ADDRESS OF THE ROUTINE. "; AS :GOSUB64300 :M=Z: INPUT"AND 
THE LAST ADDRESS. * ;AS :GOSUB64300 : INPUT'ENTER THE DECIMAL LINE NUMBER OF TH 

E FIRST DATA STRING. ";D$ 
64210 PRINT"THE DECIMAL STARTING ADDRESS IS" ;M:PRINT"TOTAL BYTES IN THE ROUTINE: 

";Z-M+1:INPUT"PRESS ENTER FOR THE LISTING OF THE FIRST 60 BYTES OF THE 
ROUT 

INE EXACTLY AS IT SHOULD APPEAR IN A DATA STRING. " ;X:J=M:CLS 
64220 PRINT">";D$;"DATA";:FORI=JTOJ+59:N=PEEK(I) : IFI>ZTHEN64290 
64230 IFN>99P$=RIGHT$(STR$(N) ,3) :GOTO64260 
64240 IFN>9F$=RIGHT$(STR$(N) ,2) :GOTO64260 
64250 PS=RIGHT$(STR$(N),1) 
64260 PRINTPS,-:IFKJ+59ANDKZPRINT","; 
64270 NEXT:PRINT:INPUT"PRESS ENTER FOR THE NEXT 60 BYTES. ";A:J=J+60 :X=VAL(D$) +10 

:Y=LEN(D$):D$=RIGHT$(STR$(X),Y) :GOTO64220 
64290 END 
64300 F=16:Z=0:J=LEN(A$) :FORK=lTOJ:BS(K) =MIDS(AS,K,1) :X=VAL(B$ (K) ) : IFX>0THEN6433 


64310 IFB$(K)="0"THEN64360 
64320 X=ASC(B$(K))-55 
64330 P=J-K 

64340 IFP>0THENX=X*F:P=P-1:GOTO64340 
64350 Z=Z+X 
64360 NEXT:RETURN 
64400 N=1:IFD>255N=3 
64410 H$="":FORI=NTO0STEP-1:K=INT(D/F[I) :D=D-K*F[I: IFK>9THENH$=H$+CHR$(K+55) :NEX 

TBLSEH$=H$+RIGHT$(CHR$(K+48) ,1) :NEXT 
64420 RETURN 
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INTRODUCTION 
by Frank J. Myers 



TO DIFFERENTIAL AMPLIFIERS: 



MSIC 
jUTBBfTM. i 


tv ■ 


Van 


1 12* ll 

* *>iie 


PRESS EH1BU0 DOTHE? . 


-V 



This program is an introduc- 
tory level course in the theory 
and design of differential am- 
plifier circuits. Excellent 
graphics and step-by-step 
prompting make this program an 
excellent teaching aid for the 
electronics instructor. Several 
design problems are included for 
student practice. 



970 REM *** THE DIFFERENTIAL AMPLIFIER *** 

980 REM *** BY FRANK M. MYERS *** 

1000 CLS:PRINT CHR$ (23) :PRINT6450, "THE DIFFERENTIAL AMPLIFIER" 

1010 FOR A=1TO1500:NEXT 

1100 CLS:PRINT" THE DIFFERENTIAL AMPLIFIER CIRCUIT IS THE MOST IM-" 

1110 PRINT"PORTANT BUILDING BLOCK IN ANALOG CIRCUIT APPLICATION AND" 

1120 PRINT"DESIGN. A DIFFERENTIAL AMPLIFIER, WHICH IS COMMONLY REFERRED" 

1130 PRINT"TO AS A DIPF AMP, PROVIDES HIGH VOLTAGE GAIN TO DIFFERENTIAL" 

1140 PRINT"SIGNALS APPLIED BETWEEN ITS INPUTS, AND PROVIDES LITTLE OR" 

1150 PRINT"NO GAIN TO THOSE SIGNALS WHICH ARE COMMON TO BOTH INPUTS." 

1160 PRINT"IN OTHER WORDS, THE DIFFERENTIAL AMPLIFIER PRODUCES AN AM-" 

1170 PRINT"PLIFIED OUTPUT SIGNAL LINEARLY RELATED TO THE DIFFERENCE BE-" 

1180 PRINT'TWEEN TWO INPUT SIGNALS." 

1190 PRINT" DESIGN SYMMETRY IS THE KEY TO THE OPERATION OF THE" 

1200 PRINT"DIFFERENTIAL AMPLIFIER. THIS IS SHOWN IN THE FOLLOWING" 

1210 PRINT"CIRCUIT.":PRINT:PRINT 

1220 INPUT"PRESS ENTER TO CONTINUE", -A 

1222 GOSUB 1230 

1223 GOSUB 1320 
1225 GOTO 16 80 

1227 REM *** BASIC DIFFERENTIAL AMPLIFIER SCHEMATIC SUBROUTINES *** 

1230 CLS:PRINT@64, "BASIC " :PRINTg94+B, "+V" :PRINTgl28 , "DIFFERENTIAL" 

1240 PRINTS192, "AMPLIFIER" 

1270 PRINT@275+B,"Rl":PRINT@298+B,"R2":PRINTe345+B,"OUTl" 

1280 FRINT§354+B,"OUT2":PRINTe409+B,CHR${92):PRINTe411+B,"Il":PRINTg418+B,"I2" 

1285 PRINT@421+B,CHR$(92):PRINT@462+B,"INl":PRINTe470+B,"Ql" 

1290 PRINT@487+B,"Q2":PRINT@494+B,"IN2" 

1300 PRINT?738+B,CHR$(92) : PRINT8740+B, "IS" :PRINTg862+B, "-V" 

1310 RETURN 

1320 FOR A=43 TO 82 

1330 SET(A+C,9):SET(A+C,30) 

1340 NEXT A 

135 FOR A=6 TO 8 

1360 SET(62+C,A) :SET(63+C,A) 

1370 NEXT A 

1380 FOR A=19 TO 25 

1390 SET(40+C,A) :SET(85+C,A) 

1400 NEXT A 

1410 FOR A=15 TO 19 

1420 SET(43+C,A) :SET(82+C,A) 

1430 NEXT A 

1440 SET(43+C,10) :SET(43+C,11) :SET(82+C,10) :SET(82+C,11) :SET(44+C,25) 

1445 SET(81+C,25) 

1450 FOR A=25 TO 30 

1460 SET(43+C,A) :SET(82+C,A) 

1470 NEXT A 

1480 SET(42+C,20) :SET(41+C,21) :SET(41+C,23) :SET(42+C,24) :SET(83+C,20) 

1485 SET(84+C,21) 

1490 SET(84+C,23) :SET(83+C, 24) 

1500 FOR A=12 TO 14 

1510 SET(42+C,A) :SET(44+C,A) :SET(81+C,A) :SET(83+C,A) 

1520 NEXT A 

1530 FOR A=44 TO 47 

1540 SET(A+C,16) :NEXT A 

1550 FOR A=78 TO 81 

1560 SET(A+C,16) :NEXT A 
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1840 


PRINT" 1) 


1850 


PRINT" 2) 


1860 


PRINT" 3) 


1870 


PRINT" 


1880 


PRINT: PRINT" 



1570 FOR A=36 TO 39 

1580 SET(A+C,22):NEXT A 

1590 FOR A=86 TO 89 

1600 SET(A+C,22):NEXT A 

1610 FOR A=31 TO 33 

1620 SET(62+C,A) :SET(63+C,A) :NEXT A 

1630 FOR A=36 TO 38 

1640 SET(62+C,A) :SET(63+C,A):NEXT A 

1650 FOR A=33 TO 36 

1660 SET(60+C,A) :SET(61+C,A) :SET(64+C,A) :SET(65+C,A) :NEXTA 

1670 RETURN 

1675 REM *** END OF DIFFERENTIAL AMPLIFIER SCHEMATIC SUBROUTINES *** 

1680 INPUT'PRESS ENTER TO CONTINUE", -A 

1690 CLS:PRINT"THE ABBREVIATED TERMS USED IN THE SCHEMATIC OF THE DIF-" 

1695 PRINT"FERENTIAL AMPLIFIER ARE DEFINED AS FOLLOWS:" 

1700 PRINT:PRINT"Q1=Q2=NPN TRANSISTORS" 

1710 FRINT"R1=R2=MATCHED RESISTORS" 

1720 PRINT"IS=CONSTANT CURRENT SINK" 

1730 PRINT"IN1=INPUT 1" 

1740 PRINT" IN2=INPUT 2" 

1750 PRINT"OUTl=OUTPUT 1" 

1760 PRINT"OUT2=OUTPUT 2" 

1770 PRINT"+V=POSITIVE SUPPLY VOLTAGE" 

1780 PRINT"-V=NEGATIVE SUPPLY VOLTAGE" 

1785 PRINT" I1=CURRENT FLOW THROUGH Ql" 

1786 PRINT"I2=CURRENT FLOW THROUGH Q2" 
1790 PRINT: INPUT"PRESS ENTER TO CONTINUE";A 
1800 CLS:PRINTei8, "CIRCUIT ANALYSIS" 

1810 PRINT:PRINT" AS I SAID EARLIER, THE KEY TO THE DIFFERENTIAL" 
1820 PRINT'AMPLIFIER'S PERFORMANCE IS DESIGN SYMMETRY. THEREFORE, FOR" 
1830 PRINT"THIS ANALYSIS THE FOLLOWIING ASSUMPTIONS WILL BE MADE:": PRINT 
. -' Ql AND Q2 ARE PERFECTLY MATCHED TRANSISTORS." 
Rl AND R2 ARE PERFECTLY MATCHED RESISTORS." 
EQUAL INPUT VOLTAGES ARE APPLIED TO EACH INPUT." 
(VIN1=VIN2)" 

THE CONSTANT CURRENT SINK (IS) SINKS A CONSTANT" 
1890 PRINT"CURRENT AT ALL TIMES, REGARDLESS OF OTHER CIRCUIT CONDITIONS." 
1900 PRINT:INPUT"PRESS ENTER TO CONTINUE";A 

1910 CLS: PRINT "BEING THAT VIN1 AND VIN2 ARE OF EQUAL MAGNITUDES," 
1920 PRINT"EXACTLY HALF OF THE CURRENT (IS) FLOWS THROUGH Ql AND" 
1930 PRINT"HALF THROUGH Q2. THESE CURRENTS PRODUCE VOLTAGE DROPS" 
1940 PRINT"ACROSS Rl AND R2, WHICH RESULT IN THE OUTPUT VOLTAGES 1" 
1950 PRINT"AND 2 (VOl AND V02). THIS RELATIONSHIP IS EXPRESSED BY:" 
1960 PRINT: PRINT8397, "VOD= (VOl -V02) =A(VIN1-VIN2) " 

1970 PRINT: PRINT"WHERE A IS THE VOLTAGE GAIN OF TRANSISTORS Ql AND" 
1980 PRINT"Q2 AS COMMON EMITTER AMPLIFIERS." 
1990 PRINT:PRINTe719,"A=(V01-V02)/(VINl-VIN2) " 
2000 PRINT: INPUT"PRESS ENTER TO CONTINUE" ;A 

2010 CLS:PRINT" AS A RULE, (I1+I2=IS) DURING NORMAL OPERATION OF THE" 
2020 PRINT"DIFFERENTIAL AMPLIFIER. ANY DIFFERENCE BETWEEN VIN1 AND VIN2" 
2030 PRINT"WILL CAUSE AN IMBALANCE IN THE CURRENTS II AND 12, BUT" 
2040 PRINT" (11+12) MUST STILL EQUAL (IS). THE FOLLOWING EXAMPLES WILL" 
2050 PRINT" ILLUSTRATE THIS AND SHOW WHAT HAPPENS TO VOl AND V02 AS" 
2060 PRINT"VIN1 AND VIN2 ARE CHANGED." 

2062 PRINT:PRINT"IN THE FIVE EXAMPLES WHICH WILL BE GIVEN, THE FOLLOW-" 
2064 PRINT'ING ASSUMPTIONS MUST BE MADE:":PRINT 

2066 PRINT"(1) R1=R2=10K (2) +V=15V (3) -V=-15V (4) -V < VIN < +V" 

2067 PRINT" (5) VIN1 - VIN2 < ABS(2) 

2068 PRINT: PRINT: INPUT"PRESS ENTER TO CONTINUE";A 
2070 CLS:GOSUB 1230 

2072 GOSUB 1320 

2074 PRINT8896,:INPUT"PRESS ENTER TO CONTINUE";A 

2075 FOR F=1T05 

2076 CLS:PRINTS10, "DIFFERENTIAL AMPLIFIER ANALYTICAL EXAMPLE ";F 

2077 PRINT: INPUT"ENTER A VALUE FOR VIN1";V1 

2078 PRINT: INPUT"ENTER A VALUE FOR VIN2" ;V2:PRINT:PRINT 

2090 D=V1-V2:IT=3E-3:V=38. 46153846 :E=2. 718281828 

2091 R1=10E3:R2=R1:H=15:G=-15 

2095 IF ABS(D)>2 PRINT"VIN1 - VIN2 > ABS (2)" : GOTO 2077 

2096 CLS :PRINT@10, "DIFFERENTIAL AMPLIFIER ANALYTICAL EXAMPLE ";F 

2097 GOSUB 2100 

2098 GOTO 2230 

2100 I1=(IT*(E[(V*D)))/(1+(E[(V*D))) 
2110 I2=IT/(1+(E[(V*D))) :IS=I1+I2 

2130 V3=(-I1*R1)+H:V4=(-I2*R2)+H 

2131 IF ABS(V3)>ABS(G)THENGOTO10000 

2132 IF ABS(V4)>ABS(G)THENGOTO10000 
2135 B=12:C=24 

214 PRINTe94+B,"+V":PRINT@256,"VINl=";Vl;"V":PRINT@275+B,"Rl" 

2150 PRINT8298+B,"R2":PRINTe320,"VIN2=";V2;"V":PRINTg345+B,"VOl" 

2160 PRINT§355+B,"VO2":PRINTg384,"Il=";H,-"A":PRINTe409+B,CHR$(92) 

2170 PRINTg411+B,"Il":PRINTe418+B,"I2":PRINT?421+B,CHR$(92) 

2180 PRINT@448,"I2="; 12; "A" :PRINTS461+B, "VIN1" :PRINT8470+B, "Ql" 

2190 PRINTe487+B,"Q2":PRINTe494+B,"VIN2":PRINTe512,"IS=";IS;"A" 

2200 PRINTe576,"VOl=";V3;"V":PRINT8640,"VO2=";V4;"V":PRINT8738+B,CHRS(92) 

2210 PRINT8740+B,"IS":PRINT6862+B,"-V" 

2220 GOSUB 1320 
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2225 RETURN 

2230 PRINT8896,: INPUT-PRESS ENTER TO CONTINUB";A 

2240 NEXT F 

2250 CLS: PRINT" NOW THAT YOU THROUGHLY UNDERSTAND THE DIFFERENTIAL" 

2260 PRINT'AMPLIFIER, I WILL GIVE YOU A CHANCE TO EXPERIMENT WITH DIF-" 

2270 PRINT"FERENT VALUES FOR EACH OF THE CIRCUIT COMPONENTS WHICH MAKE" 

2280 PRINT"UP THE BASIC DIFFERENTIAL AMPLIFIER. THIS WILL ALLOW YOU" 

2290 PRINT'TO BETTER UNDERSTAND THE EFFECT OF THE COMPONENT VALUES ON" 

2300 PRINT"THE OVERALL CIRCUIT OPERATION. YOUR ONLY RESTRICTION IS THAT" 

2310 PRINT"YOU MUST USE THE SAME BASIC DIFFERENTIAL AMPLIFIER CIRCUIT" 

2320 PRINT'SCHEMATIC AS I DID." 

2330 PRINT" TO REFRESH YOUR MEMORY OF THAT SCHEMATIC, I WILL DRAW" 

2340 PRINT"IT AGAIN BEFORE YOU BEGAN ENTERING THE COMPONENT VALUES. ": PRINT: PRINT 

2350 INPUT"PRESS ENTER TO CONTINUE"; A 

2355 B=0:C=0 

2360 GOSUB 1230 

2370 GOSUB 1320 

2380 PRINTe896,:INPUT"PRESS ENTER TO CONTINUE";A 

2390 CLS :PRINT815, "DIFFERENTIAL AMPLIFIER DESIGN" :PRINT 

2400 INPUT"ENTER A VALUE FOR +V";H 

2410 INPUT"ENTER A VALUE FOR -V";G 

2420 INPUT"ENTER A VALUE FOR R1";R1 

2430 INPUT"ENTER A VALUE FOR R2";R2 

2440 INPUT"ENTER A VALUE FOR IS" ,- IT 

2450 INPUT"ENTER A VOLTAGE TO BE APPLIED TO INPUT l"jVl 

2460 INPUT"ENTER A VOLTAGE TO BE APPLIED TO INPUT 2"jV2 

2465 D=V1-V2 

2470 IF ABS(D)>2PRINT:PRINT"INPUT 1 - INPUT 2 > ABS(2)":GOTO 2450 

2472 IF VI >HORVKGPRINT: PRINT" INPUT 1 EXCEEDS + OR - V":GOTO2450 

2474 IF V2>HORV2<GPRINT:PRINT"INPUT 2 EXCEEDS + OR - V":GOTO2460 

2480 V=38.46153846:E=2. 718281828 

2485 CLS :PRINTS15, "DIFFERENTIAL AMPLIFIER DESIGN" 

2490 GOSUB 2100 

2500 PRINT6896, 

2510 INPUT"DO YOU WISH TO ENTER ANOTHER SET OF COMPONENT VALUES"; A? 

2520 IF A$="YES"THEN2390 

2530 CLS:PRINT"THIS ENDS THE THEORY AND PRACTICE SESSION ON DIFFERENTIAL" 

2540 PRINT'AMPLIFIERS. NEXT, YOU WILL BE GIVEN A SHORT QUIZ ON THE" 

2550 PRINT'SUBJECT, AND GRADED." 

2560 FOR A=1T03 000: NEXT 

2570 GOSUB 12000 

2580 PRINT" (1) DOES A DIFFERENTIAL AMPLIFIER PROVIDE HIGH VOLTAGE" 

2590 INPUT"GAIN TO DIFFERENTIAL SIGNALS", -AS 

2600 IF A$="YES" GOSUB 13000 ELSE GOSUB 14000 

2610 GOSUB 12000 

2620 INPUT"(2) WHAT IS ANOTHER NAME FOR THE DIFFERENTIAL AMPLIFIER" ; AS 

2630 IF AS="DIFF AMP" GOSUB 13000 ELSE GOSUB 14000 

2640 GOSUB 12000 

2650 PRINT"(3) DOES A DIFFERENTIAL AMPLIFIER PROVIDE HIGH VOLTAGE" 

2660 INPUT"GAIN TO SIGNALS COMMON TO IT'S INPUTS" ;A$ 

2670 IF AS="NO" GOSUB 13000 ELSE GOSUB 14000 

26 80 GOSUB 12000 

2690 PRINT" (4) IS THE OUTPUT SIGNAL OF A DIFFERENTIAL AMPLIFIER" 

2700 PRINT"LINEARLY RELATED TO THE DIFFERENCE BETWEEN TWO INPUT SIG-" 

2710 INPUT"NALS";AS 

2720 IF A$="YES" GOSUB 13000 ELSE GOSUB 14000 

2730 GOSUB 12000 

2740 PRINT" (5) WHAT IS THE KEY TO THE PROPER OPERATION OF THE DIF-" 

2750 INPUT"FERENTIAL AMPLIFIER" ; AS 

2760 IF A$="DESIGN SYMMETRY" GOSUB 13000 ELSE GOSUB 14000 

2770 GOSUB 12000 

2780 PRINT"{6) A CONSTANT CURRENT SINK (OR SOURCE) WILL SINK A CON-" 

2790 PRINT"STANT CURRENT REGARDLESS OF OTHER CIRCUIT CONDITIONS WITH" 

2800 PRINT"THE EXCEPTION OF POWER LOSS OR DEVICE JUNCTION BREAKDOWN." 

2810 PRINT: INPUT"TRUE OR FALSE", -AS 

2820 IF A$="TRUE" GOSUB 13000 ELSE GOSUB 14000 

2830 GOSUB 12000 

2840 PRINT" (7) REFERRING TO THE SCHEMATIC OF THE DIFFERENTIAL AM-" 

2850 PRINT"PLIFIER USED IN THE EXAMPLES, II + 12 = IS." 

2860 PRINT: INPUT"TRUE OR FALSE", -AS 

2870 IF AS="TRUE" GOSUB 13000 ELSE GOSUB 14000 

2880 GOSUB 12000 

2890 PRINT"{8) ASSUME THAT A=-569.914. USING THE FORMULAE GIVEN" 

2900 PRINT"IN THE CIRCUIT ANALYSIS SECTION OF THIS PRESENTATION, CAL-" 

2910 PRINT"CULATE THE DIFFERENTIAL OUTPUT VOLTAGE (VOD) OF A DIFFEREN-" 

2920 PRINT"TIAL AMPLIFIER IF 1.01 VOLTS WAS APPLIED TO INPUT 1 AND" 

2930 PRINT"1 VOLT WAS APPLIED TO INPUT 2." 

2940 PRINT: INPUT"ENTER YOUR ANSWER HERE";A 

2950 IF A=-5. 69914 GOSUB 13000 ELSE GOSUB 14000 

2960 GOSUB 15000 

10000 FOR A=1T05 

10010 CLS:PRINT CHRS (23) : PRINT6466 , "DESIGN ERROR" 

10020 FOR J=1TO50:NEXTJ 

10030 CLS 

10040 FOR J=1TO50:NEXTJ 

10050 NEXT A 
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10060 
10070 



10090 
12000 
12010 
13000 
13010 
13020 
13030 



14010 
14020 
14030 
14040 
14050 
14060 
14070 
15000 
15010 
15020 
15030 
15040 
15050 



PRINTe448,"THE OUTPUT VOLTAGE IS ATTEMPTING TO EXCEED ABS(-V) . 

PRINT'CHECK THE VALUE OP Rl AND R2 OR IS." 

FOR J=1TO1500:NEXTJ 

GOTO 2390 

CLS:PRINTei5, 'DIFFERENTIAL AMPLIFIER QUIZ": PRINT: PRINT 

RETURN 

CLS:PRINT CHRS(23) :PRINTe470, "CORRECT" 

Q=Q+1 

FOR A=1TO1000:NEXT 

RETURN 

CLS 

FOR A=l TO 5 

PRINT CHR$(23) :PRINT6470, "WRONG" 

FOR B«l TO 50:NEXTB 

CLS 

FOR B=l TO 50:NEXTB 

NEXT A 

RETURN 

CLS:A=(Q/8)*100:PRINT CHR$(23) 

PRINTS448,"YOUR QUIZ SCORE IS" , -A; "PERCENT. " 

FOR B=1TO1500:NEXT 

CLS:PRINT CHRS (23) :PRINT6470,"THE END" 

FOR B=1TO1000:NEXT:CLS 

REM *** END OF PROGRAM *** 



SURVEYOR CALCULATIONS: by Duane Bristow 



This program will draw a 
rough plot from bearings, or 
azimuths and distances. Lati- 
tudes and departures, error of 
closure, and DMP areas in closed 
traverses are also calculated. 
Data can be saved on tape, and 
up to 499 bearings and distances 
may be entered. 
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GOSUB10000:CLEAR100:CLS:Q=449:DIMB(Q),DI(Q),DE(Q),L(Q):ONERRORGOTO70:K1=.017 4 

533:K2=57.29578:QS="«*t«.Mf" 
PRINTTAB(10)"S URVEYING CALCULATION S" :PRINT:PRINT"COPYRIG 

HT 1979 BY DUANE BRISTOW, ALBANY, KY." 
PRINT: PRINT'THIS PROGRAM ALLOWS THE SURVEYOR TO ENTER EITHER BEARINGS OR A 

ZIMUTHS AND DISTANCES OF A TRAVERSE. THE PROGRAM WILL THEN DRAWA ROUGH PLAT 

, CALCULATE LATITUDES AND DEPARTURES, ERROR OF CLOSURE, AND IF THE TRA 

VERSE CLOSES, "; 
PRINT"DMD AREA. IT WILL ALSO CALCULATE THE BEARING OF CLOSURE AND BALANCE 
LATITUDES AND DEPARTURES. ALL DATA CAN BE SAVED ON TAPE FOR LATER US 

E.":PRINT"THE PROGRAM ALLOWS ENTRY OF UP TO" ;Q; "BEARINGS AND DISTANCES." 
PRINT"USE OF A PRINTER WILL ALLOW A HARDCOPY PLAT. ": PRINT: INPUT"ENTER 'B' FOR 

OUTPUT IN BEARINGS OTHERWISE OUTPUT WILL BE AZIMUTH" ;BES 
Q=0:PRINT" *** 'B' FOR BACKUP. I FOR MENU. ***":GOTO100 
PRINT:PRINT"ERROR OF TYPE" (ERR/2+1; "IN LINE";ERL:RESUME510 
PRINT"BACKUPI ";:N=N-1 :1 " 

IFBE$="B"THENA=B(N+1) :GOSUB900ELSEA$=STR$ (B(N+1) ] 
IFN<0THENN=0 

PRINT"STATION";N+l; "BEARING ";A$;" DISTANCE" ;DI (N+l ) 
AS=" [ ": PRINT "STAT ION" ; N+l ; : INPUT"BEARING" ; A$ : IFA$="B"THEN95ELSEIFA$=" [ "THEN5 

00ELSEIFLEFT$(A$,1)="N"ORLEFTS(AS,1)="S"THEN150ELSEIFASC(A$)>57ORASC(AS)<48 

THENPRINT"REDO " ; :GOTO100ELSEA=VAL (A$) 
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102 IPA<jlTgEjjl|jjELSEIFA>360THENA=A-360 :GOTO102 

110 INPUT"DISTANCE";DI(N):IFDI(NX0THENPRINT"REDO ";:GOTO110 

115 Q=Q+1:DE(N)=SIN(B(N)*K1)*DI(N) :L (N) =COS(B(N) *K1) *DI (N) 

120 IFQ=7THEN50ELSE100 

150 BS=LEFT$(AS,1) : A$=RIGHTS (AS ,LBN (AS) -1) : A=VAL(AS) : IFA<0ORA>90THENPRINT"REDO 

::GOTO100ELSEAS=RIGHT$(AS,1):IFBS="N"THEN180 
155 IFAS="E"THEN170ELSEIFAS<>"W"THENPRINT"REDO " ; :GOTO100ELSEA=180+A:GOTO104 
170 A=180-A:GOTO104 

180 IFAS="E"THBN104ELSEIFASO"W"THBNPRINT"REDO " ; : GOTO100ELSEA=360-A:GOTO104 
200 CLS: PRINT" JUST A SEC. " :L3=0:D3=0:L1=0:L2=0:D1=0:D2=0: FORI=0TON :D3=D3+DE(I) : L 

3=L3+L(I) :IFD3>=D2THEND2=D3ELSEIFD3<=D1THEND1=D3 
202 IFL3>=L2THENL2=L3ELSEIFL3<=L1THENL1=L3 
204 NEXT:AS="":A=104:Q=46:RO=2.28:INPUT"WILL YOU WANT A HARDCOPY OF PLAT";AS:IFL 

EFTS ( AS , 1 ! ="Y"THENCI=10 : 1,1=6 : CH=80 : GOTO3000 
208 CLS : X1=D2-D1 : Y1=L2-L1 : IFX1>Y1THENX1=A/X1 : Y1=X1/R0ELSEY1=Q/Y1 : X1=Y1*R0 
210 Q=0:DD=DE(1) :AR=0:D3=0:L3=0:FORI=0TON 
215 AR=AR+DD*L(I):D3=D3+DE(I):L3=L3+L(I) :Q=Q+DI(I> 
220 X8=X1*(D3-D1):Y8=Y1*(L3-L1) 
230 J=I+1:IFI=NTHENJ=0 

240 DD=DD+DE(I)+DE(J) :X9=X1* (D3+DEU) -Dl) : Y9=Y1* (L3+L ( J) -LI) 
245 S=SGN(X9-X8) :IFABS(X9-X8X.5THENX8=X9-.01:S=.0005 
250 M=(Y9-Y8)/(X9-X8) :B=Y8-M*X8 
260 FORX=X8TOX9STEPS 

27 Y=M*X+B: IFX>=- . 5ANDX<=127 . 9ANDY>=- . 40ANDY< = 47 . 5THENSET (X + . 5 , 47 . 5-Y) 
280 NEXTX,I 
285 A$=INKEYS:PRINTe245, "PRESS ANY"; :PRINT8309 ,"KEY TO"; : PRINT8373, "CONTINUE, "; : 

PRINT6501 , "OR PRESS P" ; : PRINT6565 , "FOR" ; : PRINTS629 , "PRINTED" ; : PRINTS693 , "CO 

PY . " ; 
290 AS=INKEYS:IFAS=""THEN290ELSEIFAS="P"ANDPEEK( 14312 ) =63THENGOSUB2000 
300 CLS:IFL3=0THENL3=. 000001 
305 A=SQR(D3[2+L3[2) : IFA<.01*QTHENPRINT"AREA IS";TAB(50) USING"###*# . »#";ABS(AR/2 

) :Q=1: INPUT" ENTER CONVERSION FACTOR BY WHICH TO DIVIDE" ;Q: PRINT"AREA IS";TA 

B(50)USING"###tS.S#";ABS(AR/(2*Q)) 
310 PRINT: PRINT"SUM OF LATITUDES IS" ;TAB(50) USINGQS;L3 : PRINT"SUH OF DEPARTURES I 

S",-TAB(50)USINGQS;D3:PRINT"ERROR OF CLOSURE IS" ;TAB(50) USINGQS;A:PRINT"AZIM 

UTH BEARING OF CLOSURE IS" ;TAB( 50) ; : A=K2*ATN (D3/L3) :A=A+360 : IFL3>0THENA=A-1 

80 
315 IFA>360THENA=A-360 

317 A=INT(A*1000)/1000:IFBE$="B"THENGOSUB900ELSEA$=STR$(A) 
320 PRINTA$:PRINT:GOTO50 
500 CLS 
510 PRINT"PRESS NUMBER TO: ":PRINT" 1. ADD BEARINGS?" :PRINT" 2. TAPE DA 

TA OR RECALL FROM TAPE?" :PRINT" 3. BALANCE LATITUDES AND DEPARTURES?": 

PRINT" 4. DRAW PLAT AND CALCULATE AREA AND ERROR OF CLOSURE?" 
515 PRINT" 5. RECALL ALL BEARINGS AND DISTANCES?" 
520 A$=INKEY$:IFAS=""THEN520ELSEA=VAL(A$):IFA<1ORA>5THEN520ELSECLS:ONAGOTO50,600 

,800,200,1000:GOTO500 
600 PRINT"PRESS NUMBER TO:":PRINT" 1. TAPE DATA FROM MEMORY?" : PRINT" 2. 
RECALL DATA FROM TAPE?" :PRINT" 3. CHECK RECORDED DATA?" :PRINT" 4 

. NEITHER OF THE ABOVE?" 
610 A$=INKEYS:IFAS=""THEN610ELSEA=VAL(AS):IFA<1ORA>4THEN610ELSECLS:ONAGOTO620,65 

0,700,500:GOTO600 
620 PRINT'SET UP RECORDER WITH BLANK TAPE, PRESS RECORD AND PLAY KEYS. " : PRINT"WH 

EN READY ENTER LABEL FOR TAPE. " : INPUTAS 
625 PRINTt-1 ,AS ,N:FORI=0TONSTEP15 :PRINT6900 , I ; "-" ; 1+14 ; 
630 PRINT#-1,B(I),DI(I) ,B(I+1) ,DI (1+1) ,B(I+2) ,DI (1+2) ,B(I+3) ,DI (1+3) ,B(I+4) ,DI (I 

+4) ,B(I+5) ,DI(I+5) ,B(I+6) ,DI(I+6) ,B(I+7) ,DI(I+7) ,B(I+8) ,DI (1+8) ,B(I+9) ,DI (I 

+9) , B( 1+10), DI ( 1+10), B( 1+11 ),DI(I+11),B( 1+12), DI( 1+12), B( 1+13) ,DI (1+13) ,B(I 

+14),DI(I+14) 
635 NEXT:PRINT"ALL DATA IS NOW RECORDED ON TAPE 1 " :PRINT:GOTO600 
650 PRINT"SET UP RECORDER AND RUN TAPE TO PROPER STARTING POSITION. PRESS 

PLAY KEY.":INPUT#-1,AS,N:PRINT:PRINT"READING TAPE: ";AS 
660 FORI=0TONSTEP15 : PRINTS900 , I ; "-" ; 1+14 ; 
670 INPUTt-l r B(I),DI(I),B(I+l),DI(I+l),B(I+2),DI(I+2),B(I+3),DI(I+3),B(I+4),DI(I 

+4) ,B(I+5),DI(I+5),B(I+6) ,DI(I+6) ,B(I+7) ,DI(I+7) ,B(I+8) ,DI (1+8) ,B(I+9) ,DI (I 

+9) , B( 1+10 ),DI( 1+10), B(I+11) ,DI(I+11) ,B ( 1+12), DI ( 1+12) ,B(I+13) ,DI(I+13) ,B(I 

+14),DI(I+14) 
680 NEXT:GOSUB770:PRINT"ALL DATA IS NOW IN MEMORY 1 " :PRINT:GOTO510 
700 PRINT"REWIND RECORDER TO PROPER STARTING PLACE AND PRESS PLAY KEY. " : INPUTS-1 

,AS,J:PRINT:PRINT"CHECKING TAPE: " ; AS : IFJONTHEN750 
710 FORI=0TONSTEP15:PRINT@900,I;"-";I+14; 
720 MPUT#-1,L(I),DE(I),L(I+1),DE(I+1),L(I+2),DE(I+2),L(I+3),DE(I+3),L(I+4),DE(I 

+4) ,L( 1+5), DE (1+5) ,1.(1+6) ,DE(I+6) ,L(I+7) ,DE(I+7) ,L(I+8) ,DE(I+8) ,L(I+9) ,DE(I 

+9) ,L(I+10) ,DE(I+10) ,L(I+11) ,DE(I+11) ,L(I+12) ,DE(I+12) ,L(I+13) ,DE(I+13) ,L(I 

+14),DE(I+14) 
725 NEXT:FORI=0TON:IFABS(L(I)-B(I)+DI(I)-DE(I))>.05THEN750 
730 NEXT:PRINT"TAPE IS GOOD1 " :GOSUB770 : PRINT:GOTO600 
750 PRINT"BAD DATA ON TAPEI 1 " :GOSUB770 :PRINT:GOTO600 

770 FORI=0TON:DE(I)=SIN(B(I)*K1)*DI(I) :L ( I) =COS (B(I) *K1) *DI ( I) :NEXT:RETURN 
800 L3=0:D3=0:L1=0:FORI=0TON:PRINT6RND(1023) , "*" ; :DE(I) =SIN(B(I) *K1) *DI (I) :L(I)= 

C0S(B(I)*K1)*DI(I) :L3=L3+L(I) :D3=D3+DE(I) :L1=L1+DI(I) :NEXT 
810 FORI=0TON:PRINTSRND(1023),"*";:DE(I)=DE(I)-D3*DI(I)/L1:L(I!=L(I)-L3*DI(I)/L1 
:NEXT:PRINT8900,"ALL LATITUDES AND DEPARTURES BALANCED BY COMPASS RULE.":AS 

="":PRINT:INPUT"DO YOU WISH TO LIST ADJUSTED BEARINGS AND DISTANCES" ; AS : IFL 

EFTS(AS,1)O"Y"THEN500 
820 CLS : PRINT"STATION" ; TAB ( 12) "BEARING", -TAB (24) "DISTANCE" ;TAB( 36) "ADJ. BEARING"; 
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TAB(50)"ADJ. DISTANCE" 
825 FORI=0TON:IFBB?="B"THENA=B(I) :GOSUB900ELSEA$=STR$ (B( I) ) 
830 PRINTTAB(5)I;TAB(15)A$;TAB(27)DI(I);:J=SQR(DE<I) [2+1,(1) [2) 

832 IFL(I)O0THENA=K2*ATN(DE(I)/L(I))ELSEA=0 

833 A=A+360:IFL(I)<0THENA=A-180 

834 IFA>=360THENA=A-360 

835 IFBE$="B"GOSUB900ELSEA$=STRS (A) 

836 PRINTTAB(39)A$;:PRINTTAB(52)J:IFI>0ANDI/14=INT(I/14)THENINPUT"PRESS ENTER" ;B 

S 
840 NEXT:INPUT"PRESS ENTER" ;A$ :GOTO500 
900 IFA>270THENA$="N"+STR$(360-A)+" W"ELSEIFA>180THENA$="S"+STR$ (A-180) +" W"ELSE 

IFA>90THENA$="S"+STR$(180-A)+" E"ELSEA$=»N"+STR$ (A) +" E" 
910 RETURN 
1000 ' 
1010 PRINT"STATI0N";TAB(12) "BEARING" ;TAB( 24) "DISTANCE" ;TAB(36) "LATITUDE" ;TAB( 48) 

"DEPARTURE" 
1015 FORI=0TON:A=B(I) : IFBE$="B"THENGOSUB900ELSEA$=STR$ (A) 
1020 PRINTTAB(5)I;TAB(15)A$;TAB(27)DI(I);TAB(39)L(I);TAB(51)DE(I) : IFI>0ANDI/12=I 

NT(I/12)THENGOSUB1100 
1050 NEXT:GOSUB11B0:GOTO500 

1100 J=99 99:INPUT"ENTER STATION * TO CHANGE DATA OR PRESS ENTER TO CONTINUE",-J 
1102 IFJ<0ORJ>NTHENRETURNELSEA=B(J) : IFBE$="B"THENGOSUB900ELSEA$=STR$ (A) 
1110 PRINT"BEARING: PRESS ENTER FOR ";A$;" OR ENTER NEW BEARING" ; : INPUTA$:GOSUBl 

200:B(J)=A:PRINT"DISTANCE: PRESS ENTER FOR" ;DI ( J) ; "OR ENTER NEK DISTANCE"; 

:INPUTDI(J) 
1120 DE(J)=SIN(B(J)*K1)*DI(J) :L( J) =COS (B( J) *K1) *DI { J) :RETURN 
1200 IFLEFTS(A$,1)0"N"ANDLEFT$(A$,1)0"S"THENA=VAL<A$) :RETU RN 
1210 BS=LEFT$(A$,1):A$=RIGHT$<A$,LEN(A$)-1}:A=VAL<A$):IFA<0ORA>90THENA=0ELSEA!!=R 

IGHT$(A$,1) :IFB$="N"THEN1280 
1220 IFA$="W"THENA=180+A:RETURN 
1230 A=180-A:RETURN 

1280 IFA$="E"THENRETURNELSEA=36 0-A:RETURN 
2000 FORI=(46-INT(A/RO+.5))T047:FORJ=1TOA 
2010 IFPOINT(J,I)=0THENLPRINT" " ;ELSELPRINT"*" ; 
2020 NEXTJ:IFCH>ATHENLPRINT" " 
2040 NEXTrRETURN 
3000 PRINT'PLAT ON VIDEO SCREEN MAY BE OUT OF PROPORTION EITHER HORIZONALLYOR VE 

RTICALLY TO ALLOW CORRECT SCALE ON HARDCOPY PRINT. ": INPUT"# CHARACTERS PER 

LINE";CH: INPUT"* LINES PER INCH" ;LI: INPUT"* CHARACTERS PER INCH" ;CI :RO=CI/L 

3002 A=CH:IFA>104THENA=104 

3004 Q=INT(A/RO+.5):IFQ>46THENQ=46:A=INT(Q*RO+.5) 

3010 GOTO208 

10000 RETURN 



COMPLEX CIRCUIT ANALYSIS: by G & M Diebett 



Nine configurations of R, L 
and C circuits are presented in 
this program. Resonant frequen- 
cy, R values, L values and C 
values are input by the user. The 
computer will calculate' reac- 
tance, phase angle and total im- 
pedance. A very handy tool for 
the designer. 



5 W=57.29 6 

10 A=3. 145927 

15 GOSUB6000 

30 INPUT'WHAT ROUTINE IS NEEDED" ;T 

40 ONT GOTO100, 300,400, 500, 700, 800, 900, 1000, 1100 

100 PRINT"SERIES R L C CIRCUIT" 

105 PRINT 
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110 GOSUB3000 

120 Z=((R[2+ABS(X-X1) [2) [.5) 

125 U=(X-X1):IFX1>XTHSNU=U*<-1) 

130 P=ATN((U)/R)*W 

140 PRINT"THE REACTANCE OF L IS ";X;" OHMS 

145 PRINT'THE REACTANCE OF C IS ";X1;" OHMS" 

150 GOSUB2000 . „ „„„„ „ 

160 PRINT"THE CIRCUIT IMPEDANCE IS ; Z ; OHMS; nPrRPPq" 

170 IFX>X1THENPRINT" INDUCTIVE WITH A PHASE ANGLE OF ; P DEGREES 

180 IFX1>XTHEN PRINT"CAPACITIV£ WITH A PHASE ANGLE OF ;P; DEGREES 

190 GOTO5000 

300 PRINT"FOR R S L IN SERIES" 

302 PRINT 

305 GOSUB3000 

310 Z=(R[2+X[2) (.5 

330 Pm™"THe'c?RCUIT Z IS ";Z;" OHMS INDUCTIVE WITH A PHASE ANGLE OF "jP;" DEGR 

335 PRINT"THE REACTANCE IS ";X; n OHMS" 

340 GOTO5000 

400 PRINT"SERIES CIRCUIT OF R f. C" 

405 PRINT 

410 GOSUB3000 „ „„„„. 

415 PRINT"THE REACTANCE OF C IS ";X1;" OHMS 

420 Z=(R12+X1[2) t.5 

440 P R S»THE R ciRCUIT Z IS -,»,- OHMS WITH A PHASE ANGLE OF -";P ; " DEGREES" 

450 GOTO5000 

500 PRINT"SERIES L 6 C" 

510 GOSUB3000 „.,„-■ 

520 PRINT"THE CIRCUIT Z IS ";ABS(X-XU; OHMS 

530 IFX>X1THENPRINT"THE PHASE ANGLE IS 90 DEGREES 

540 IFX1>XTHENPRINT"THE PHASE ANGLE IS -90 DEGREES 

550 IFX=X1THENPRINT"THE PHASE ANGLE IS DEGREES 

560 PRINT"THE XL IS ";X;" OHMS 6 THE XC IS "jXl; OHMS 

570 GOTO5000 

700 PRINT"R & L IN PARALLEL" 

705 PRINT 

710 GOSUB3000 

720 PRINT'THE XL IS ";X;" OHMS" 

730 PRINT'THE CIRCUIT Z IS " ; <R*X) / < (R[2+X [ 2) ) [ . 5 

740 PRINT"THE PHASE ANGLE IS " ; ATN (R/X) *W; " DEGREES" 

750 GOTO5000 

800 PRINT"R S C IN PARALLEL 

810 GOSUB3000 

812 J=(R/X1) 

820 PRINT'THE CIRCUIT Z IS " ; (R*Xl)/( (R[2+X1 [2) [ .5) , " OHMS AT -";P;" DEGREES" 

840 PRINT"THE XC IS ";X1;" OHMS" 

850 GOTO5000 

900 PRINT" R L C IN PARALLEL" 

910 GOSUB3000 

915 IFX1>XTHENU=U*(-1) 

920 Z=(R*X*X1)/(((X[2)*(X1[2)+(U)[2)[.5) 

930 P=ATN(((R*X1)-(R*X))/(X1*X))*W 

Q^S TFX1 i"XTHENP = P* ( — X ) 

940 PRINT"THE XL IS ";X;" OHMS, XC= ";X1,-" OHMS THE IMPEDANCE IS "; 

950 PRINTZ;"OHMS WITH A PHASE ANGLE OF ";P;" DEGREES" 

960 GOSUB5000 

1000 PRINT'R 6 L IN PARALLEL WITH C" 

1010 GOSUB3000 

1020 U=(X-X1) 

1030 IFX1>XTHENU=U*(-1) 

1040 Z=Xl«(((R[2+X[2)/(R[2+U[2))l-5) 

iS2§ SpTHrS'^^X^^nc'^-.-Xl;" OHMS, THE CIRCUIT Z IS ";Z;" OHMS" 

1080 PRINT'THE CIRCUIT PHASE ANGLE IS ";Pi" DEGREES" 

1090 GOTO5000 

1100 PRINT"R S C IN PARALLEL WITH L S R" 

1110 INPUT"WHAT IS THE INDUCTANCE AND SERIES RESISTANCE" ;L,R1 

1120 INPUT'WHAT IS THE CAPACITANCE AND SERIES RESISTANCE" ;C, R2 

1130 INPUT'WHAT IS THE FREQUENCY";F 

1140 X=2*A*F*L 

1150 Z=IuRlutx[2)*(R2[2+XlU)>/<(Rl+R2)l2*ABS(X-Xl)[2))l.5 ,,.„.,,„„ 
1160 P=ATO((X*(R2[2 + X1[2)-X1*(R1[2«[2))/(R1*(R2[2+X1[2)+R2*{RU2+X[2)))*W 

1170 PRINT 

1180 PRINT'THE CIRCUIT Z IS ";Z;" OHMS AT AN ANGLE OF ";P;" DEGREES." 

1190 PRINT'THE XL OF THE INDUCTANNCE IS ";X;" OHMS AT A " ; 

1191 PRINT'PHASE ANGLE OF " i ATN (X/Rl) *W; " DEGREES" 

1195 PRINT'THE XC OF THE CAPACITOR IS ";X1;" OHMS AT A PHASE ANGLE OF "j-ATN(Xl/ 

R2)*W; "DEGREES" 
1200 GOTO5000 
2000 P=ATN(J)*W 
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2010 


RETURN 


3000 


INPUT'WHAT IS THE FREQUENCY" ;F 


3010 


INPUT'WHAT IS THE R VALUE";R 


3020 


INPUT-WHAT IS THE L VALUE", -L 


3030 


INPUT'WHAT IS THE C VALUE";C 


3040 


X=2*A*F*L 


3045 


IFC=0THENRETURN 


3050 


X1=1/(2*A*F*C) 


3060 


RETURN 


5000 


INPUT'ANOTHER 1=YES 0=NO";S 


5010 


CLS 


5020 


IFS=1G0T015 


5030 


END 


6000 


PRINT'THE FOLLOWING ROUTINES ARE AVAILABLE' 


6010 


PRINT" (1) SERIES RLC CKT" 


6020 


PRINT" (2) SERIES RL CKT" 


6030 


PRINT" (3) SERIES RC CKT" 


6040 


PRINT" (4) SERIES LC CKT" 


6050 


PRINT" (5) PARALLEL RL CKT" 


6060 


PRINT" (6) PARALLEL RC CKT" 


6070 


PRINT" (7) PARALLEL RLC CKT" 


6080 


PRINT" (8) RL IN PARALLEL WITH C" 


6090 


PRINT" (9) RC IN PARALLEL WITH LR" 


6100 


PRINT:PRINT:RETURN 



BASECHANGE: by Ron Moehlis 



r A godsend for computer freaks 
whose friends insist on program- 
ming in octal or hex decimal. 
Enter the base and number given, 
select the new base and zap, the 
number, as it appears in the new 
base, is displayed on the monitor. 
Almost too easy. 



am n£ «sb then m. mm t,n 

DfTEF IK IB B«S£? I 
73 IN USE 8 IS 1118II. IH MS I 

ENTER THE KE> THEN THE WHS? 1(,73 
ENTER THE IB ««£? 2 

: m base it is ieeieei. ui base i 

ENTEB THE BSD THEN THE KKBER? ., 



1 REM *** BASE CHANGE *** 

2 REM *** BY RON MOEHLIS *** 

5 CLEAR (1000) 

6 DEPDBL S,X,Y,W,R,Z 

7 CLS 

10 DIM BS(50),C5(50) 

20 N$="123456789ABCDEF" 

30 INPUT" ENTER THE BASE, THEN THE NUMBER" ;BI,A$ 

40 NL=0:NR=0:P=0:S=0 

50 FOR 1=1 TO LEN(AS) 

60 IF MIDS(A$,I,1)=" " THEN 140 

70 IF MID$(A$,I,1)<>"." THEN 90 

80 P=l:GOTO 140 

90 IF P=l THEN 120 

100 NL=NL+1 

110 BS(NL)=MID$(AS,I,l):GOTO 140 

120 NR=NR+1 

130 CS(NR)=MIDS(AS,I,1) 

140 NEXT I 

150 S=0 

155 IF NL=0 THEN 220 

160 FOR 1=1 TO NL:Z=l:FOR J-l TO BI-1 

170 IF B$(I)="0" THEN 210 

180 IF B$(I)OMID$(N$,J,l) THEN 200 

184 IF NL-I=0 THEN 190 

185 FOR K=l TO NL-I : Z=Z*CDBL (BI) :NEXT K 
190 S=S+CDBL(J)*Z:G0TO 210 

200 NEXT J:PRINT "ERROR IN LEFT ";A$: GOTO 30 
210 NEXT I 
214 S=INT(S) 



209 



215 IF NR=0 THEN 275 

220 FOR 1=1 TO NR:Z=l:FOR J= 1 TO BI-1 

230 IF C$(I)="0" THEN 270 

240 IF C?(I)OMID$(N?,J,l) THEN 260 

245 FOR K=l TO I : Z=Z*CDBL (BI) :NEXT K 

250 S=S+CDBL(J)/Z:GOTO 270 

260 NEXT J: PRINT" ERROR IN RIGHT ";A$: GOTO 30 

270 NEXT I 

27 5 INPUT" ENTER THE NEW BASE"; BO 

276 IF BOO10 THEN 340 

280 PRINT A$;" IN BASE ";BI;" IS ";S;" IN BASE 10":PRINT 

290 GOTO 30 

340 D$=A$:SL=INT(S) :SR=S-SL:AS="" :K=0 

35 IF SL=0 THEN 410 

360 X=INT(SL/B0):R=SL-X*BO 

370 IF RO0 THEN 390 

380 A?="0"+A$:GOTO 400 

390 A$=MID$(NS,R,1)+A$ 

400 SL=X:GOTO 350 

410 A$=AS+"." 

420 IF SR=0 THEN 490 

430 K=K+1:IF K=40 THEN 490 

440 W=INT(SR*BO) :Y=SR*BO~W 

450 IF W>0 THEN 470 

455 IF W<0THEN 490 

460 A5=AS+"0":GOTO 480 

470 A5=A$+HID$(N$,W,1) 

4B0 SR=Y:GOTO 420 

490 PRINTDS;" IN BASE ";BI; 

495 PRINT 

500 GOTO 30 



IS ";AS;" IN BASE 



NUMERICAL ANALYSIS 1: by D. Carlson 



This program is designed to aid 
in calculations of three different 
types of interpolations, in- 
cluding: Neville's Iteration, 
Natural Cubic Splines and 
Clamped Splines. More than 
that, none of our editors can tell 
you! 
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100 CLS 

110 CIS 

120 DEFINT I,J r K,N 

130 DEFDBL A,B,C,D,F,L,H,Q,X,Y,Z 

140 DIM A(20),B(20),C(20),D(20),L(20),H(20),Q(20,20),X(20),Y(20),Z(20) 

150 PRINT "NUMERICAL ANALYSIS 1 : INTERPOLATION" : PRINT: PRINT 

160 PRINT "1) NEVILLE'S ITERATION 

170 PRINT "2) NATURAL CUBIC SPLINES" 

180 PRINT "3) CLAMPED CUBIC SPLINES" 

190 PRINT: PRINT: PRINT 

200 INPUT "INPUT THE NUMBER CORRESPONDING TO YOUR DESIRED METHOD ":C 

210 IF C=l GOTO 260 

220 IF C=2 GOTO 550 

230 IF C=3 GOTO 1070 

240 PRINT "INVALID REPLY. I REPEAT," 

250 GOTO 200 

26 CLS 

270 PRINT "NEVILLE'S ITERATED INTERPOLATION" :PRINT 

280 INPUT "INPUT THE X VALUE YOU WISH TO INTERPOLATE F(X) ON ";X 

290 INPUT "INPUT THE NUMBER OF DATA POINTS (MUST BE 20 OR LESS) ";N:N=N 

300 IF N>20 PRINT "TOO MANY. I REPEAT," 
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310 IF N>20 GOTO 290 

320 CLS 

330 PRINT "INPUT THE DATA AS X,F(X) " :PRINT 

340 FOR K=0 TO N 

350 INPUT X(K) ,Q(K,0) 

360 NEXT K 

370 FOR 1=1 TO N 

380 FOR J=l TO I 

390 Q(I,J)=((X-X(I))*Q(I-1,J-1)~(X-X<I-J))«Q<I,J-1))/(X(I-J)-X(I)) 

400 NEXT J 

410 NEXT I 

420 CLS 

430 PRINT "F(";X;") APPROXIMATELY EQUALS " ;Q(N,N) : PRINT 

440 INPUT "ANOTHER X VALUE TO INTERPOLATE ON (Y OR N) ";REPLYS 

450 IF (REPLY$="NO") OR (REPLY$="N") GOTO 490 

460 IF (REPLY$<>"YES") AND (REPLY$<>"Y") GOTO 440 

470 INPUT "INPUT THE NEW X VALUE ";X 

460 GOTO 370 

490 INPUT "ANOTHER FUNCTION TO INTERPOLATE (Y OR N) ";REPLY$ 

500 IF (REPLYS="NO") OR (REPLYS="N") THEN END 

510 IF (REPLYSO'YES") AND <REPLY$<>"Y") GOTO 490 

520 CLS 

530 GOTO 270 

540 END 

550 AS="## H.tHltttHtUU H.itttttt«tt[[[[ #S .##!#«#»«*» [[[ I" 

560 CLS 

570 PRINT "NATURAL CUBIC SPLINE INTERPOLATION" :PRINT 

580 INPUT "INPUT THE NUMBER OF DATA POINTS (MUST BE 20 OR LESS) ";N 

590 IF N>20 PRINT "TOO MANY. I REPEAT," 

600 IF N>20 GOTO 580 

610 N-N-l 

620 CLS 

630 PRINT "INPUT THE DATA AS X,F(X) ":PRINT 

640 FOR 1=0 TO N 

650 INPUT X(I),Y{I) 

660 NEXT I 

670 FOR 1=1 TO N-l 

680 *&i°?x(I))i(X(J?!x^^ 

6 90 NEXT I 

700 L(0)=1:M(0)=0:Z(0)=0 

710 FOR 1=1 TO N-l 

720 L(I)=2*(X<I+1)-X(I-1))-(X(I)-X(I-1))*M(I-1) 

730 M(I)=(X(I+1)-X(I))/L(I) 

740 Z{I)=(A(I)-(X(I)-X(I-1))*Z(I-1))/L(I) 

750 NEXT I 

760 L(N)=1:Z(N)=0:C(N)=0 

770 FOR J=N-1 TO STEP -1 

780 C(J)=Z(J)-M(J)*C(J+1) 

790 B(J)=(Y(J+l)-Y(J))/(X(J+l)-X(J))-(X(J+l)-X(J))*(C(J+l)+2*C(J))/3 

800 D(J)=(C(J+l)-C(J))/3/(X(J+l)-X(J)) M '" 

810 NEXT J 

820 CLS 

830 PRINT " J B(J) C (J) D(J)«:PRINT 

840 FOR J=0 TO N-l ( ' -"" m 

850 PRINT USING AS; J,B ( J) ,C ( J) ,D ( J) 

860 NEXT J 

870 PRINT 

880 INPUT^"INPUT THE X VALUE YOU WISH TO INTERPLOATE F(X) ON ";X:PRINT 

900 IF X>=X(I) AND X<=X(I+1) GOTO 940 

910 NEXT I 

920 IF X<X(0) THEN 1=0 

930 IF X>X(N) THEN I=N-1 

940 F=Y(I)+B(I)*(X-X(I))+C(I)*(X-X(I)) [ 2+D( I) * <X-X( I) ) [3 

950 PRINT "s"iI;"(";Xl") = ";F:PRINT 

960 INPUT "ANOTHER X VALUE TO INTERPOLATE ON (Y OR N) ", -REPLY? 

970 IF (REPLYS="NO") OR (REPLY$="N") GOTO 1020 

980 IF (REPLY$<>"YES") AND (REPLY$< > "Y") GOTO 960 

990 CLS 

1000 INPUT "INPUT THE NEW X VALUE ";X:PRINT 

1010 GOTO 890 

1020 INPUT "ANOTHER FUNCTION TO INTERPOLATE (Y OR N) ";REPLYS 

1030 IF (REPLY$="NO") OR <REPLY$="N") THEN END 

1040 IF (REPLY SO "YES") AND (REPLYSO'Y") GOTO 1020 

1050 GOTO 550 

106 END 

1070 CLS 

1080 AS="*# «».«#««#####([[[ «#.###*######[[([ ##.#*########[[[[" 

1090 PRINT "CLAMPED CUBIC SPLINE INTERPOLATION" :PRINT 

1100 INPUT "INPUT THE NUMBER OF DATA POINTS (MUST BE 20 OR LESS) ";N 

1110 IF N>20 PRINT "TOO MANY. I REPEAT," 

1120 IF N>20 GOTO 1100 

1130 N=N-1 

1140 CLS 

1150 PRINT "INPUT THE DATA AS X, F (X) " :PRINT 

1160 FOR 1=0 TO N 
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117B INPUT X(I),Y(I) 

1180 NEXT I 

1190 CLS 

1200 INPUT "INPUT F'(X0) ";F0 

1210 INPUT "INPUT F'(XN) ";F1 

1220 A(0)=3*(Y(1)-Y(0))/(X(1)-X(0))-3*F0 

1230 A(N)=3»F1-3*(Y(N)-Y(N-1>)/(X(N>-X(N-1)) 

1240 FOR 1=1 TO N-l 

1250 A(I)=3*(Y(I+1)*(X(I)-X(I-1))-Y(I)*(X(I+1)-X(I-1))+Y(I-1)*(X(I+1)-X(I)))/((X 

(I+1)-X(I))*(X(I)-X(I-1))) 
1260 NEXT I 

1270 L(0)=2*(X(1)-X(0)) :M(0)=.5:Z(0)=A(0)/L(0) :B(0)=F0 
1280 FOR 1=1 TO N-l 

1290 L(I)=2*(X(I+1)-X(I-1))-(X(I)-X(I-1))*M(I-1) 
1300 M(I)=(X(I+1)-X(I))/L(I) 
1310 Z(I)=(A(I)-(X(I)-X(I-1>)*Z(I-1))/L(I) 
1320 NEXT I 
1330 L(N) = (X(N)~X(N-1))*(2-M(N-1)):Z(N) = (A(N)-(X(N)-X(N-1))*Z<N-.1))/L(N):C(N)=Z( 

N) 

1340 FOR J=N-1 TO STEP -1 

1350 C(J)=Z(J)-H(J)*C(J+1) 

1360 B(J)=(Y(J+l)-Y(J))/(X(J+l)-X(J))-(X(J+l)-X(J))*(C(J+l)+2*C(J))/3 

1370 D(J)=(C{J+l)-C(J)>/3/(X(J+l)-X(J>) 

1380 NEXT J 

1390 CLS 

1400 PRINT " j B(J) C(J) D(J)":PRINT 

1410 FOR J=0 TO N-l 

1420 PRINT USING AS; J,B( J) ,C(J) ,D( J) 

1430 NEXT J 

1440 PRINT 

1450 INPUT "INPUT THE X VALUE YOU WISH TO INTERPOLATE F(X) ON ";X:PRINT 

1460 FOR 1=0 TO N-l 

1470 IF X>=X(I) AND X<=X(I+1) GOTO 1510 

1480 NEXT I 

1490 IF X<X(0) THEN 1=0 

1500 IF X>X(N) THEN I=N-1 

1510 F=Y(I)+B(I)*(X-X(I))+C(I)*(X-X(I))[2+D(I)*(X-X(I})13 

1520 PRINT "S";I;"(";X;") = ";F:PRINT 

1530 INPUT "ANOTHER X VALUE TO INTERPOLATE ON (Y OR N) ";REPLY5 

1540 IF (REPLYS="NO") OR (REPLYS="N") GOTO 1590 

1550 IF (REPLYSO"YES") AND <REPLYSO"Y") GOTO 1530 

1560 CLS 

1570 INPUT "INPUT THE NEW X VALUE ";X:PRINT 

1580 GOTO 1460 

1590 INPUT "ANOTHER FUNCTION TO INTERPOLATE (Y OR N) ";REPLY$ 

1600 IF (REPLYS="NO") OR (REPLY?="N") THEN END 

1610 IF (REPLY?<>"YES") AND (REPLY$<>"Y") GOTO 1590 

1620 GOTO 107 

1630 END 
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DESIGN APPLICATIONS FOR THE LM3900: by Tony Scarpelli 



This program features eight 
OPAMP design applications, 
based around the LM3900 chip. 
Pulse generator, active bandpass 
filter, high and low pass filter and 
AC amplifier are included. Com- 
plete circuit perameters are taken 
into account and derived compo- 
nent values graphically display- 
ed. Extremely useful to the pro- 
fessional designer. 
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5 GOTO 8000 

10 REM INVERTING AC AMPLIFIER (N V(BE) BIASING) 

15 CLS: PRINT" INVERTING AC AMPLIFIER" 

20 PRINT"WE WILL ASSUME THE FOLLOWING VALUES:" 

30 PRINT"C(IN)=1 MFD":CIN=1 

40 INPUT"IS THIS ALL RIGHT (Y-N)";A$ 

50 IF AS="Y"THEN 70 ELSE IF ASO"N"THEN 40 

60 INPUT'WHAT VALUE OF C(IN) DO YOU WANT {MFD)";CIN 

70 PRINT"R1=100K THUS Z (IN) =100K" :R1=100000 

80 INPUT'IS THIS ALL RIGHT {Y-N)";AS 

90 IF AS="Y"THEN 110 ELSE IF A$<>"N"THEN 80 

100 INPUT"WHAT VALUE OF Rl DO YOU WANT <0HMS)";R1 

110 INPUT"DO YOU KNOW WHAT THE SOURCE IMPEDANCE IS (Y-N)";A$ 

120 IF A$="N"THEN RS=0:GOTO 140 

125 IF A$<>"Y"THEN 110 

130 INPUT'WHAT IS IT (OHMS)";RS 

140 INPUT'WHAT GAIN A(V) DO YOU WANT";AV 

150 R2=AV*R1 

160 PRINT'WHAT DC OUTPUT VOLTAGE V(ODC) DO YOU WANT," 

170 INPUT"USUALLY THIS WILL BE 1/2 SUPPLY VOLTAGE", -VODC 

180 R3=R2/((VODC/.5)-l) 

190 IF RS=0 THEN 210 

200 F=(1/(6.28*CIN*(R1+RS)))*1000000 

210 CLS:PRINT"HERE ARE YOUR VALUES," 

220 PRINT"DUE TO TOLERANCES THEY WILL BE APPROXIMATE:" 

230 PRINT: PRINT"C( IN) =";CIN; "MFD" 

240 PRINT"Z(IN) & R1=";R1;"0HMS" 

250 PRINT"R2=";R2;"0HMS" 

260 PRINT"R3=";R3;"OHMS" 

270 PRINT"GAIN A(V)=";AV 

280 PRINT"V(ODC)=";VODC;"VOLTS" 

290 IF RS=0 THEN PRINT"NO LOW FREQUENCY VALUE CAN BE CALCULATED. 

300 PRINT'APPROXIMATE LOW FREQUENCY RESPONSE:" 

310 PRINT"F=";F;"HZ" 

320 INPUT'DO YOU WANT TO CHANGE LOW FREQ RESPONSE (Y-N)";A$ 

330 IF AS="N"THEN 370 ELSE IF A$<>"Y"THEN 320 

340 INPUT"WHAT FREQUENCY DO YOU WANT (HZ)";F 

350 C=(l/ (6. 28*F*(R1+RS)> 1*1000000 

360 PRINT"USE C(IN) =";C; "MFD INSTEAD" 

370 INPUT"DO YOU WANT TO DO THIS DESIGN AGAIN (Y-N)";A$ 

380 IF A$="Y"THEN 20 ELSE IF A$<>"N" THEN 370 

390 GOTO8310 

500 REM NON-INVERTING AC AMPLIFIER 

505 CLS:PRINT"NON~INVERTING AC AMP" 

510 PRINT"WE WILL ASSUME THE FOLLOWING VALUES:" 

520 PRINT"C(IN)=.05 MFD":CIN=.05 

530 INPUT'IS THIS ALL RIGHT (Y-N)";A$ 

540 IF AS="Y"THEN 560 ELSE IF ASO'N" THEN 530 

550 INPUT'WHAT VALUE OF C(IN) DO YOU WANT (MFD)",-CIN 

560 PRINT"R1=100K THUS Z (IN) =100K" :R1=100000 

570 INPUT"IS THIS ALL RIGHT (Y-N)";A$ 

580 IF A$="Y"THEN 600 ELSE IF A?<>"N" THEN 570 

590 INPUT'WHAT VALUE OF Rl DO YOU WANT (0HMS)";R1 

600 INPUT'DO YOU KNOW WHAT THE SOURCE IMPEDANCE IS (Y-N)";AS 

610 IF A$="N" THEN RS=0:GOTO 642 

620 IF A$<>"Y" THEN 600 

630 INPUT'WHAT IS IT (OHMS)";RS 
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642 PRINT"WHEN R4=R5 THEN V(REF)=l/2 V+" 
644 PRINT"R4=R5=47K":R4=47000:R5=47000 

646 INPUT"IS THIS ALL RIGHT (Y-N)";A$ 

647 IF A$="Y"THEN 650 ELSE IF ASO"N"THEN 646 

648 INPUT'WHAT VALUE OF R4 AND R5 DO YOU WANT (OHMS) " ;R4 ,R5 
650 INPUT'WHAT GAIN A(V) DO YOU WANT";AV 

660 R3=AV*R1 

670 PRINT'WHEN R2=R3 THEN V(ODC) =V(REF) " :R2=R3 

672 INPUT"IS THIS ALL RIGHT (Y-N)";AS 

674 IF A?="Y"THEN 680 ELSE IF ASO"N"THEN 672 

676 INPUT'WHAT VALUE OF R2 DO YOU WANT (OHMS)";R2 

680 IF RS=0 THEN 700 

690 F=(1/(6.28*CIN*(R1+RS)))*1000000 

700 CLS:PRINT"HERE ARE YOUR VALUES'," 

710 PRINT'DUE TO TOLERANCES AND SIMPLIFIED FORMULAS," 

720 PRINT"THEY WILL BE APPROXIMATE:" 

730 PRINT: PRINT"C< IN) =";CIN; "MFD" 

740 PRINT"Z(IN) 5 Rl=";Rl;"OHMS" 

750 PRINT"R3=";R3;"OHMS" 

760 PRINT"R2=";R2;"OHMS" 

770 PRINT"C(F)=100 MFD" 

790 PRINT"R4=";R4;"OHMS R5=" ;R5; "OHMS" 

800 PRINT'GAIN A(V)=";AV 

810 IF RS=0 THENPRINT"NO LOW FREQUENCY VALUE CAN BE CALCULATED. ": GOTO 890 

820 PRINT"APPROXIMATE LOW FREQUENCY RESPONSE: F=";F;"HZ" 

840 INPUT"DO YOU WANT TO CHANGE LOW FREQ RESPONSE (Y-N)";A? 

850 IF AS="N"THEN 890 ELSE IF ASO"Y"THEN 840 

860 INPUT"WHAT FREQUENCY DO YOU WANT (HZ)";F 

870 C= (1/(6 .28*F* (Rl+RS) ) } *1000000 

880 PRINT"USE C (IN) =" ;C; "MFD INSTEAD" 

890 INPUT"DO YOU WANT TO DO THIS DESIGN AGAIN (Y-N)";AS 

900 IF A$="Y" THEN 510 ELSE IF A$<>"N" THEN 890 

910 GOTO 8310 

1000 REM HIGH PASS ACTIVE FILTER 

1005 CLS:PRINT"HI PASS ACTIVE FILTER" 

1010 GOSUB 6000 

1020 C3=C1 

1030 INPUT'WHAT CORNER FREQUENCY F(O) DO YOU WANT (HZ)";FO 

1040 WO=6.28*FO 

1050 Rl=l/ (Q*WO*ClUE-6* < ( 2»HO) +1) ) 

1060 R2=((Q/(W0*C1*1E-6))*((2*H0)+D) :R3=R2 

1070 C2=Cl/HO 

1080 CLS:PRINT"HERE ARE YOUR VALUES:" 

1090 PRINT"PASS BAND GAIN H(0)=";HO 

1100 PRINT"Q=";Q 

1110 PRINT"C1=";C1;"MFD" 

1120 PRINT"C2=";C2;"MFD" 

1130 PRINT"C3=";C3;"MFD" 

1140 PRINT'CORNER FREQUENCY=" ;FO; "HZ" 

1150 PRINT"R1=";R1;"0HMS" 

1160 PRINT"R2=";R2;"0HMS" 

1170 PRINT"R3=";R3;"0HMS" 

1200 INPUT"DO YOU WANT TO SCALE R2 (Y-N)";AS 

1210 IF A$="N"THEN 1310 ELSE IF ASO'Y'THEN 1200 

1220 X=R2 

1230 INPUT"WHAT VALUE OF R2 DO YOU WANT (OHMS)";R2 

1240 S=X/R2 

1250 R1=R1/S 

1260 C1=C1*S 

1270 C2=C2*S 

1280 C3=C3*S 

1290 R3=R2 

1300 GOTO 1080 

1310 INPUT"DO YOU WANT TO SCALE C3 (Y-N)";AS 

1320 IF A$="N"THEN 1420 ELSE IF A$<>"Y"THEN 1310 

1330 X=C3 

1340 INPUT'WHAT VALUE OF C3 DO YOU WANT (MFD)";C3 

1350 S=C3/X 

1360 C1=C3 

1370 C2=C2*S 

1380 R1=R1/S 

1390 R2=R2/S 

1400 R3=R2 

1410 GOTO 1080 

1420 INPUT"DO YOU WISH TO DO THIS DESIGN AGAIN (Y-N)";A$ 

1430 IF A$="Y"THEN 1010 ELSE IF A$<>"N"THEN 1420 

1440 GOTO 8310 

2000 REM LOW PASS ACTIVE FILTER 

2005 CLS:PRINT"LO PASS ACTIVE FILTER" 

2010 GOSUB 6000 

2020 INPUT"WHAT CORNER FREQUENCY F(O) DO YOU WANT (HZ)",-FO 

2030 WO=6.28*FO 

2040 K=l/(4*Q*Q*(l+HO)) 

2042 PRINT"THE CONSTANT 'K' MUST BE POSITIVE" 

2044 PRINT'IT'S CALCULATED VALUE WAS ";K 

2046 PRINT"TO CHANGE K YOU MUST CHANGE H(O) OR Q" 

2047 INPUT"DO YOU WISH TO CHANGE K (Y-N)";A$ 
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204B IF A$="N"THEN 2050 ELSE IP ASO"Y"THEN 2047 

2049 GOSUB 6030:GOTO 2020 

2050 C2=K*C1 

2060 PRINT"C2=";C2;"MFD" 

2070 INPUT'DO YOU WANT TO CHANGE C2 TO A STANDARD VALUE (Y-N)";A$ 

2080 IF A?="N"THEN 2100 ELSE IF A$<>"Y"THEN 2070 

2090 INPUT"WHAT VALUE OF C2 DO YOU WANT (MFD) n ;C2 

2100 RA2= (1/ ( 2*Q*K*WO*Cl*lE-6) ) * (1+SQR(1- (4*K*Q*Q* (1+HO) ) ) ) 

2110 PRINT"R2 (+ CALC)=";RA2,-"OHMS":R2=RA2 

2120 RB2=U/(2*Q*K*W0*C1*1E-6))*(1-SQR(1-(4*K*Q*Q*(1+H0>))) 

2130 PRINT"R2 {- CALC) =" ;RB2; "OHMS" 

2135 PRINT"R2 WAS GIVEN THE + CALCULATION" 

2160 INPUT"DO YOU WANT TO CHANGE R2 TO A STANDARD VALUE (Y-N)",-AS 

2170 IF A$="N"THEN 2190 ELSE IF A$<>"Y"THEN 2160 

2180 INPUT"WHAT VALUE OF R2 DO YOU WANT {OHMS)";R2 

2190 Rl=R2/HO 

2200 R3=l/ ( (W0*W0*C1*1E-6*C1*1E-6*R2) *K) 

2210 PRINT"R3=";R3;"OHHS" 

2220 INPUT"DO YOU WANT TO CHANGE R3 TO A STANDARD VALUE (Y-N)";A$ 

2230 IF A$="N"THEN 2250 ELSE IF ASO"Y"THEN 2220 

2240 INPUT'WHAT VALUE OF R3 DO YOU WANT <OHMS)";R3 

2250 R4=2*((Rl/2)+R3) 

2260 CLS:PRINT"HERE ARE YOUR VALUES:" 

2270 PRINT"PASS BAND GAIN H(0)=";HO 

2280 PRINT"Q=";Q 

2290 PRINT"C1=";C1;"MFD" 

2300 PRINT"C2=";C2;"MFD" 

2310 PRINT'CORNER FREQUENCY F(O) =" ;FO) "HZ" 

2320 PRINT"R1=";R1;"0HMS" 

2330 PRINT"R2=";R2;"OHHS" 

2340 PRINT"R3=";R3i"OHMS" 

2350 PRINT"R4=";R4;"OHMS" 

2360 INPUT"DO YOU WISH TO DO THIS DESIGN AGAIN (Y-N)",-A$ 

2370 IF A$="Y"THEN 2010 ELSE IF A$<>"N"THEN 2360 

23 80 GOTO 8310 

3000 REM SINGLE AMPLIFIER BANDPASS ACTIVE FILTER 

3002 CLS:PRINT"SINGLE AMP BANDPASS FILTER" 

3004 INPUT"DO YOU NEED PRELIMINARY INFORMATION (Y-N)";A$ 

3006 IF AS="Y"THEN GOSUB 6210 ELSE IF A$<>"N"THEN 3004 

3010 PRINT"NOTE: THIS DESIGN IS GOOD FOR LOW FREQUENCIES," 

3020 PRINT" LOW GAIN AND LOW Q { <=10 ) . " 

3030 GOSUB 6020 

3040 INPUT"WHAT CENTER FREQUENCY F(O) DO YOU WANT (HZ)";FO 

3050 WO=6.28*FO 

3060 C2=C1 

3070 Rl=Q/(HO*WO*Cl*lE~6) 

3080 R2=Q/(((2*Q*Q)-HO)*WO*ClUE-6) 

3090 R3={2*Q)/(WO*Cl*lE-6) 

3100 R4=2*R3 

3110 CLS:PRINT"HERE ARE YOUR VALUES:" 

3120 PRINT"PASS BAND GAIN H(0)=";HO 

3130 PRINT"Q=";Q 

3140 PRINT"C1=";C1;"MFD" 

3150 PRINT"C2=";C2;"MFD" 

3160 PRINT'CENTER FREQUENCY F(O) =" ;FO; "HZ" 

3170 PRINT"R1=";R1;"0HMS" 

3180 PRINT"R2=";R2;"OHMS" 

3190 PRINT"R3=";R3;"OHMS" 

3200 PRINT"R4=";R4;"OHMS NOTE: V(REF)=V+" 

3205 PRINT'USE CLOSEST STANDARD VALUES" 

3210 PRINT: INPUT'DO YOU WISH TO DO THIS DESIGN AGAIN (Y-N)";A$ 

3220 IF AS="Y"THEN 3004 ELSE IF ASO"N"THEN 3210 

3230 GOTO 8310 

4000 REM TWO AMPLIFIER BANDPASS ACTIVE FILTER 

4005 CLS:PRINT"TWO AMP BANDPASS FILTER" 

4010 INPUT"DO YOU NEED PRELIMINARY INFORMATION (Y-N)";A$ 

4020 IF AS="Y" THEN GOSUB 6210 ELSE IF ASO"N" THEN 4010 

4030 PRINT: INPUT"WHAT Q DO YOU WISH ( >10 <S0 )";Q 

4040 INPUT'WHAT CENTER FREQUENCY F(O) DO YOU WANT (HZ)";FO 

4045 WO=6.28*FO 

4050 PRINT"C2=.l MFD":C2=.l 

4060 INPUT"IS THIS ALL RIGHT (Y-N)";A$ 

4070 IF A$="Y"THEN 4090 ELSE IF A$<>"N"THEN 4060 

4080 INPUT'WHAT VALUE OF C2 DO YOU WANT (MFD)";C2 

4090 C1=C2 

4100 PRINT"K (A CONSTANT) IS USED TO REDUCE THE SPREAD OF ELEMENT" 

4102 PRINT" VALUES OR OPTIMIZE SENSITIVITY ( 1<= K <=10 ) " 

4105 PRINT'wE START WITH K=3":K=3 

4110 INPUT"IS THIS ALL RIGHT (Y-N)";A$ 

4120 IF A$="Y"THEN 4140 ELSE IF A$<>"N"THEN 4110 

4130 INPUT"WHAT VALUE OF K DO YOU WANT":K 

4140 R1=Q/(W0*C1*1E~6) 

4150 R4=R1:R6=R1 

4160 R2=R1*((K*Q)/((2*Q)-1)) 

4170 R3=R1/ ( ( ( (Q*Q) -1) - (2/K) ) + (1/ (K*Q) ) ) 

4180 R7=K*R1 

4190 HO=(SQR(Q))*K 
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4200 R5=2*R4 

4210 R8=2«((R6*R7)/(R6+R7)) 

4220 CLS:PRINT"HERE ARE YOUR VALUES" 

4230 PRINT"Q="iQ 

4240 PRINT'CENTER FREQUENCY F(0)="iFO; "HZ" 

4250 PRINT"C2=C1=";C1;"MFD" 

4260 PRINT"K=";K 

4270 PRINT"R1=";R1;"0HMS" 

4280 PRINT"R2="jR2;"OHMS" 

4290 PRINT"R3=";R3;"OHMS" 

4300 PRINT"R4=";R4;"OHMS" 

4310 PRINT"R5=";R5;"OHMS NOTE: V(REF)=V+" 

4320 PRINT"R6="iR6;"OHMS" 

4330 PRINT"R7="iR7;"OHMS" 

4340 PRINT"R8=";R8;"OHMS NOTE: V(REF)=V+" 

4350 PRINT"GAIN=";HO 

4360 PRINT'USE STANDARD VALUES FOR FINAL DESIGN" 

4370 INPUT"DO YOU WISH TO DO THIS DESIGN AGAIN (Y-N)";AS 

4380 IF A$="Y"THEN 4030 ELSE IF ASO"N"THEN 4370 

4390 GOTO 8310 

5000 REM THREE-AMPLIFIER BANDPASS ACTIVE FILTER 

5005 CLS:PRINT"THREE-AMP BANDPASS FILTER" 

5010 INPUT"DO YOU NEED PRELIMINARY INFORMATION (Y-N)";AS 

5020 IF A?="Y"THEN GOSUB 6210 ELSE IF A$<>"N"THEN 5010 

5030 PRINT: PRINT'Q FOR THIS DESIGN CAN BE >50" 

5040 INPUT'WHAT Q DO YOU WANT";Q 

5050 INPUT'WHAT CENTER FREQUENCY F(O) DO YOU WISH"iFO 

5060 WO=6.28*FO 

5070 PRINT"C1=C2=. 00033 MFD" :C1=. 00033 

5080 INPUT"IS THIS ALL RIGHT (Y-N)";AS 

5090 IF A$="Y"THEN 5110 ELSE IF A$<>"N"THEN 5080 

5100 INPUT"WHAT VALUE OF CI DO YOU WISH (MFD)";C1 

5110 PRINT"2R1=R2=R3=360K & R1=180K" :R1=180000 

5120 INPUT"IS THIS ALL RIGHT (Y-N)";A$ 

5130 IF AS="Y"THEN 5150 ELSE IF A$<>"N"THEN 5120 

5140 INPUT"WHAT VALUE OF Rl DO YOU WANT (OHMS)";Rl 

5150 R2=2*R1 

5160 R4=R1*((2*Q)-1) 

5170 R5=l/(WO*Cl*lE-6) 

5180 R6=2*R5 

5190 HO=R4/Rl 

5200 CLS:PRINT"HERE ARE YOUR VALUES" 

5210 PRINT: PRINT"Q=";Q 

5220 PRINT'CENTER FREQUENCY F(O) =" ; FO; "HZ" 

5230 PRINT"C1=C2=";C1;"MFD" 

5240 PRINT"R1=";R1;"0HMS" 

5250 PRINT"R2=R3=";R2;"OHMS" 

5260 PRINT"R4=";R4;"OHMS" 

5270 PRINT"R5=R7=";R5;"OHMS" 

5280 PRINT"R6=R8=";R6;"OHMS NOTE: V(REF)=V+" 

5290 PRINT"GAIN=";HO 

5300 INPUT"DO YOU WISH TO SCALE R4 (Y-N)";A? 

5310 IF AS="N"THEN 5370 ELSE IF ASO"Y"THEN 5300 

5320 X=R4 

5330 INPUT"WHAT VALUE OF R4 DO YOU WISH (OHMS)",-R4 

5340 S=X/R4 

5350 R1=R1/S:R2=R2/S:R3=R3/S:H0=R4/R1 

5360 GOTO 5200 

5370 PRINT"USE CLOSEST 5% STANDARD VALUE FOR FINAL DESIGN" 

5380 INPUT"DO YOU WISH TO DO THIS DESIGN AGAIN (Y-N)";A$ 

5390 IF AS="Y"THEN 5030 ELSE IF A$<>"N"THEN 5380 

5400 GOTO 8310 

6000 INPUT"DO YOU NEED PRELIMINARY INFORMATION (Y-N)";A$ 

6010 IF AS="Y"THEN GOSUB 6205 ELSE IF A?<>"N"THEN 6000 

6020 PRINT"THE FOLLOWING ARE GIVEN:" 

6030 PRINT"PASS BAND GAIN H(0)=1":HO=1 

6040 INPUT'IS THIS ALL RIGHT (Y-N)";AS 

6050 IF A$="Y"THEN 6070 ELSE IF ASO"N"THEN 6040 

6060 INPUT"WHAT GAIN DO YOU WANT";HO 

6070 PRINT"Q=1":Q=1 

6080 INPUT'IS THIS ALL RIGHT (Y-N)";A$ 

6090 IF AS = "Y"THEN 6110 ELSE IF ASO"N"THEN 6080 

6100 INPUT"WHAT Q DO YOU WANT";Q 

6110 PRINT"C1=.0003 MFD":C1=.0003 

6120 INPUT"IS THIS ALL RIGHT (Y-N)";AS 

6130 IF A?="Y"THEN RETURN ELSE IF A$<>"N"THEN 6120 

6140 INPUT"WHAT VALUE OF CI DO YOU WANT (MFD) " ;C1 :RETURN 

6200 REM ACTIVE FILTER DESIGN PRELIMINARY INFORMATION 

6205 CLS:PRINT" DESIGNING ACTIVE FILTERS" 

6210 PRINT"MULTIPLE AMPLIFIER FILTERS ARE GENERALLY BETTER" 

6220 PRINT" BECAUSE PASSIVE COMPONENTS TOLERANCES EFFECT THEM LESS. 

6230 PRINT"USE METAL FILM RESISTORS AND GOOD QUALITY CAPACITORS" 

6240 PRINT" IN THE FINAL DESIGN." 

6250 PRINT"USE RESISTANCES >10K AND <=10 MEG." 

6260 PRINT'LOWER IMPEDANCES ARE BETTER." 

6270 PRINT"SIMULTANEOUS HIGH GAIN, HIGH Q ( >=50 ), AND HIGH" 

6280 PRINT"FREQUENCY ( >1 KHZ ) DEGRADE PERFORMANCE." 
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6290 PRINT"BIASING V(REF) IN HOST DESIGNS SHOULD BE 1/2 V+" 

6295 PRINT" FOR MAXIMUM AC VOLTAGE SWING." 

6300 PRINT"USE STANDARD CAPACITANCE VALUES, AND SCALE RESISTANCES." 

6310 RETURN 

7000 REM PULSE GENERATOR 

7005 CLS:PRINT"PULSE GENERATOR" 

7010 INPUT"WHAT IS YOUR SUPPLY VOLTAGE (VOLTS) ";V 

7020 TR=V/.5 

7030 PRINT"YOUR MINIMUM PULSE WIDTH FOR THIS SUPPLY" 

7040 PRINT" VOLTAGE IS" ;TR; "MICRO-SEC. " 

7050 PRINT"THE FOLLOWING IS GIVEN:" 

7060 PRINT"LOW TRIP POINT V(L) =1 . 5V" :VL=1 . 5 

7070 INPUT"IS THIS ALL RIGHT (Y-N)";A$ 

7080 IF A$="Y"THEN 7100 ELSE IF A$<>"N"THEN 7070 

7090 INPUT'WHAT LOW TRIP POINT DO YOU WANT (VOLTS) ",-VL 

7100 PRINT'HIGH TRIP POINT V(H) =3 . 0V" : VH=3 

7110 INPUT"IS THIS ALL RIGHT (Y-N)";AS 

7120 IF A$="Y" THEN 7140 ELSE IF A$<>"N"THEN 7110 

7130 INPUT"WHAT HIGH TRIP POINT DO YOU WANT (VOLTS) ";VH 

7140 PRINT'WHAT PULSE WIDTH DO YOU WANT ( >";TR; "MICRO-SEC) (USEC) ";: INPUT T2 

7150 INPUT'WHAT PULSE REPITITION FREQUENCY DO YOU WISH (HZ)":F 

7160 Tl=l/F 

7170 PRINT"C1=.01 MFD":C1=.01 

7180 INPUT"IS THIS ALL RIGHT (Y-N)";A$ 

7190 IF A$="Y"THEN 7210 ELSE IF A$<>"N"THEN 7180 

7200 INPUT"WHAT VALUE OF CI DO YOU WISH (MFD)";C1 

7210 R2=T1/(C1*1E-6*L0G(VH/VL)) 

7220 PRINT"R2=";R2;"OHMS" 

7230 PRINT"R2 SHOULD BE APPROX. 100K TO 1 MEG." 

7240 PRINT'IF IT IS NOT CHANGE CI." 

7250 INPUT'DO YOU WISH TO CHANGE CI (Y-N)",-A$ 

7260 IF A$="Y"THEN 7200 ELSE IF A$<>"N"THEN 7250 

7270 R3=((V-.5)*R2)/VL 

7280 R4=((V-.8)-.5)/((VH/R2)-<(V-.5)/R3)) 

7290 Rl=(T2*lE-6)/(-(Cl*lE-6)*LOG(l-(VH/((V-.8)-.7)))) 

7300 CLS:PRINT"HERE ARE YOUR VALUES:" 

7310 PRINT:PRINT"SUPPLY VOLTAGE=";V; "VOLTS" 

7320 PRINT"LOW TRIP POINT V(L) =";VL; "VOLTS" 

7330 PRINT'HIGH TRIP POINT V(H)=";VH; "VOLTS" 

7340 PRINT'PULSE WIDTH=";T2; "USEC" 

7350 PRINT"PULSE REPITITION PREQ.="iF; "HZ" 

7360 PRINT"C1=";C1;"MFD" 

7370 PRINT"R1=";R1;"0HMS" 

7380 PRINT"R2=";R2;"OHMS" 

7390 PRINT"R3=";R3;"OHMS" 

7400 PRINT"R4=";R4;"OHMS" 

7410 PRINT:PRINT"USE NEAREST 5% STANDARD VALUES IN FINAL DESIGN." 

7420 INPUT"DO YOU WISH TO DO THIS DESIGN AGAIN (Y-N)";A$ 

7430 IF AS="Y"THEN 7010 ELSE IF A$<>"N"THEN 7420 

7440 GOTO 8310 

8000 CLS:PRINT" THE LM3900" 

8010 PRINT'THIS I.C. CONTAINS 4 AMPLIFIERS CALLED NORTON" 

8020 PRINT" AMPLIFIERS. tHIS TYPE OF AMPLIFIER USES CURRENT" 

8030 PRINT"DIFFERENCES ON ITS INPUTS RATHER THAN" 

8040 PRINT"VOLTAGE DIFFERENCES. THUS ITS INPUT AND BIASING" 

8050 PRINT"RESISTORS ARE VERY LARGE GIVING IT'S DESIGNS A VERY" 

8060 PRINT"HIGH INPUT IMPEDANCE. THE INPUT RESISTANCE FOR" 

8070 PRINT'EACH AMPLIFIER IS 1 MEG OHM. FOR THE DESIGNS IN" 

8090 PRINT"THIS PACKAGE YOU CAN USE A SINGLE POWER SUPPLY" 

8100 PRINT"PROM 4 TO 36 VDC. THE OPEN LOOP VOLTAGE GAIN" 

8110 PRINT"FOR A LOAD RESISTANCE OF 10K IS 70DB. THE OUTPUT" 

8120 PRINT"RESISTANCE IS 8K OHMS. THE UNITY-GAIN FREQUENCY" 

8130 PRINT"RESPONSE IS 2.5 MHZ." 

8140 PRINT:PRINT"PRESS 'G' TO GO ON." 

8150 A5=INKEY$:IF A$="G"THEN 8160 ELSE 8150 

8160 CLS:PRINT"DUE TO DIFFERENCES IN AMPLIFIERS AND" 

8170 PRINT'WHETHER THE DEVICES ARE SURPLUS, ETC., THE DESIGNS" 

8180 PRINT'CANNOT BE EXACT. ALSO THE DESIGNS MAY CALL" 

8190 PRINT"FOR UNSTANDARD COMPONENTS. BUT THE DESIGNS" 

8200 PRINT'CAN GET YOU CLOSE ENOUGH SO THAT BY BREADBOARDING" 

8210 PRINT"AND SHIFTING VALUES SLIGHTLY YOU CAN GET" 

8220 PRINT"THE CIRCUIT YOU WANT WITH STANDARD VALUES." 

8230 PRINT"TRY TO USE STANDARD CAPACITANCE VALUES FIRST" 

8240 PRINT"SINCE THERE ARE MORE VALUES OF STANpARD RESISTANCES." 

8250 PRINT'BREADBOARD WITH ANY TYPE OF RESISTOR OR CAPACITOR," 

8260 PRINT'BUT FOR FINAL DESIGN, HIGH QUALITY METAL FILM" 

8270 PRINT"RESISTORS, AND QUALITY CAPCITORS COULD BE USED" 

8280 PRINT'FOR BEST STABIILITY." 

8290 PRINT:PRINT"PRESS 'G' TO GO ON." 

8300 AS=INKEYS:IF A?="G"THEN 8310 ELSE 8300 

8310 CLS:PRINT"HERE ARE THE DESIGNS YOU CAN CHOOSE FROM:" 

8320 PRINT: PRINT'l — INVERTING AC AMPLIFIER" 

8330 PRINT"2 — NON-INVERTING AC AMPLIFIER" 

8340 PRINT"3 — HIGH PASS ACTIVE FILTER" 

8350 PRINT"4 — LOW PASS ACTIVE FILTER" 

8360 PRINT"5 — SINGLE-AMPLIFIER BANDPASS ACTIVE FILTER" 

8370 PRINT"6 — TWO-AMPLIFIER BANDPASS ACTIVE FILTER" 
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8380 PRINT"7 — THREE-AMPLIFIER BANDPASS ACTIVE FILTER" 

8390 PRINT'S — PULSE GENERATOR" 

8400 PRINT:PRINT"CHOOSE BY NUMBER THE DESIGN YOU WANT" 

8410 INPUT D 

8420 ON D GOTO 10,500,1000,2000,3000,4000,5000,7000 



DATA ANALYSIS: by Dave Dillehay 



Three types of data analysis 
are offered in this program. 
They include Linear Regres- 
sions, Standard Deviation and 
X-Bar. Select desired method of 
analysis, plug your data in and 
save your time. 




4 CLS: PRINT" 
7 PRINT 
10 PRINT" ITEM 
20 PRINT" 1. 
30 PRINT" 2. 
40 PRINT" 3. 
50 PRINT" 4. 



***** DATA ANALYSIS *****" 

ANALYSIS" :PRINT 

LINEAR REGRESSION - 2 VARIABLES" 

STANDARD DEVIATION / HISTOGRAM" 

X-BAR AND R CHART" 

NEW DATA" 



60 PRINT: INPUT"SELECT THE ITEM NUMBER FOR THE ANALYSIS DESIRED" ;C 

70 ON C GOTO 108,1000,2000,3000 

80 PRINT"SELECT FROM 1 TO 4":GOTO 60 

100 CLS:PRINT"LINEAR REGRESSION - 2 VARIABLES" 

102 CLEAR 10:DIM LI (100,1) :N=1 

103 PS="##f.##" 

105 PRINT: PRINT"DATA CAN BE ENTERED IN PAIRS AND ANALYZED" 

110 PRINT"AS ONE OF THE FOLLOWING:" 

115 PRINTTAB(25)"1. LINEAR - LINEAR" 

120 PRINTTAB(25)"2. LOG - LOG" 

125 PRINTTAB(25)"3. LOG - LINEAR" 

130 PRINT: INPUT"ENTER THE NUMBER BY THE DESIRED CHOICE" -C 

140 ON C GOTO 150,170,190 

145 PRINT"SELECT FROM 1 TO 3":GOTO 130 

150 GOSUB 900 

155 PRINT N;: INPUT" ";X,Y 

160 IF X=99 AND Y=99 THEN 200 

165 L1(N,0)=X:L1(N,1)=Y:N=N+1:GOTO 155 

170 GOSUB 900 

175 PRINT N;:INPUT" ";X,Y 

180 IF X=99 AND Y=99 THEN 200 

185 L1(N,0)=LOG{X) :Ll(N,l)=LOG(Y) :N=N+l:GOTO 175 

190 GOSUB 90 

192 PRINT N;:INPUT" ";X,Y 

194 IF X=99 AND Y=99 THEN 200 

196 L1(N,0)=LOG(X) :L1(N,1)=Y:N=N+1: GOTO 192 

200 N=N-1 

225 CLS:ON C GOTO 230,270,290 

230 G=0:FOR A=l TO N 

232 F=A-2*INT((A-l)/2) 

234 PRINTTAB(25*(F-1))A;"-";L1(A,0),-",";L1(A,1): 

235 IF F>=2 THEN PRINT 
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236 IF A>=3B+G*30 THEN INPUT'PRESS ENTER TO CONTINUE LIST-";AS:G=G+1 

23 8 NEXT A: IF A/2=INT(A/2) THEN PRINT 

245 INPUT"DO YOU WANT TO CHANGE, DELETE, OR ADD DATA (Y/N)";AS 

250 IF AS="Y" THEN 800 

265 GOTO 310 

27 G=0:FOR A=l TO N 

272 F=A-2*INT((A-l)/2) 

274 FRINTTAB(25*<F-1))A;"-";EXP(L1(A,0));",";EXP(LI(A,1)>; 

275 IF F>=2 THEN PRINT 

276 IF A>=30+G*30 THEN INPUT'PRESS ENTER TO CONTINUE LIST-" ; AS :G=G+1 
278 NEXT A:IF A/2=INT(A/2) THEN PRINT 

285 GOTO 245 

290 G=0:FOR A-l TO N 

292 F=A-2*INT((A-l)/2) 

294 PRINTTAB{25*(F-l))A,-"-";EXP(Ll(A,0));",";Ll(A,l)j 

295 IF F>=2 THEN PRINT 

296 IF A>=30+G*30 THEN INPUT'PRESS ENTER TO CONTINUE LIST-": >A$:G=G+1 
300 NEXT A: IF A/2=INT(A/2) THEN PRINT 

305 GOTO 245 

310 FOR A=l TO N:X1=X1+L1(A,0):Y1=Y1+L1(A,1) :X2=X2+L1(A,0)*L1(A,0):Y2=Y2+L1(A,1) 

*L1(A,1) :Z=Z+L1(A,0)*L1(A,1) :NEXT A 
315 X3=X1/N:Y3=Y1/N:S1=X2-X1*X3:S2=Y2-Y1*Y3:S=Z-X1*Y3 
320 B=S/S1:B1=Y3-B*X3:S3=S2-B*S 
325 IF N>2 THEN S4=S3/(N-2) 
330 PRINT'NUMBER = ";N 

335 PRINT "MEAN OF X = ";X3," OF Y = ";Y3 
340 PRINT'SLOPE = ";B,"Y - INTERCEPT = ",-Bl 
345 PRINT: PRINT'SUM OF SQUARES" , "TOTAL" jY2 
350 PRINT'HEAN = ";Y3*Y1;" SLOPE = ";B*S 
352 PRINT"RESIDUAL = ";S3 
355 PRINT: PRINT'STANDARD DEVIATIONS" 
360 PRINT"X= ";SQR(S1/(N-1)),"Y = ";SQR(S2/(N-1) ) 
362 IF S4<0 THEN PRINT: PRINT:GOTO 375 
365 PRINT"ERROR = " ;SQR(S4) , "Y-BAR = ";SQR(S4/N) 

370 PRINT'SLOPE = " ;SQR(S4/S1) , "Y-INTER. = " ;SQR{S4* (1/N+X3*X3/S1 ) ) 
375 PRINT: IF S4O0 THENPRINT"F-RATIO FOR SLOPE = ";B*S/S4 
380 PRINT"CORR. COEFF. = ";S/SQR(S1*S2) 
385 INPUT"DO YOU WANT A PLOT (Y/N)";A$ 
390 IF AS="N" THEN 805 
395 IF A$="Y" THEN 400 

398 PRINT"PLEASE ANSWER Y OR N" ; : GOTO 385 
400 CLS:PRINT@475, "WORKING" 
405 MN(1,1)=L1(1,1):MN(1,0)=L1(1,0) :FOR A=l TO N: IF LI (A,0)<HN(1,0) THEN MN<1,0) 

=L1(A,0) 

410 IF L1(A,1)<HN(1,1) THEN MN(1 ,1) =L1 (A, 1) 

411 NEXTA 

415 FOR A=l TO N:IF LI (A, 0) >MX(1,0) THEN HX(1 , 0) =L1 (A, 0) 

420 IF L1(A,1)>MX(1,1) THEN MX<1,1) =L1{A,1) 

421 NEXTA 

425 H1=40/(MN(1,1)-HX(1,D) : J1=-MX{1,1) *H1 

430 H2=100/(MX(1,0)-MN(1,0)):J2=27-MN(1,0)*H2 

435 CLS:FOR A=0 TO 40 :SET(26 ,A) :NEXTA:FOR A=0 TO 30 STEP 10:SET(27 ,A) :NEXT A 

440 FOR A=26 TO 127 : SET (A, 41) : NEXTA: FOR A=51 TO 126 STEP 25:SET(A,40) :NEXT A 

445 PRINT8448 , "Y" ; : PRINTS930, "X" ; 

450 FOR A=l TO N:SET(L1 (A,0) *H2+J2,L1 (A,l) *H1+J1) :NEXTA 

455 PRINT6837,"";: PRINT USING P$;MN{1,1) ,- :PRINT@5, ""; :PRINT USING P$;MX(1,1) ; 

460 PRINT690 8,"";:PRINT USING PS;MN(1,0) ; :PRINT@954,"" ; :PRINT USING P$;HX(1,0); 

465 FOR A=27 TO 125:E= ( ( (A-J21/H2) *B+B1) *H1+J1 

466 IF E<0 THEN 472 
470 SET(A,E) 

472 NEXT A 

475 PRINT@960,"SLOPE=";B!"INTER.=",-Blj 

480 INPUT" PRESS ENTER TO CONTINUE-" ; AS : GOTO 800 

700 K=0:W=31+G*30:G=G+1:RETURN 

800 PRINT'ENTER A COMMAND TO ADD - DELETE - CHANGE - LIST - END" 

805 INPUT"COMMAND";AS 

810 IF AS="ADD" THEN 835 

815 IF A$ = "DELETE" THEN 840 

820 IF A$ = "CHANGE" THEN 875 

825 IF AS="LIST" THEN GOSUB 920:GOTO 225 

828 IF A$="END" THEN RUN4 

830 PRINT"ILLEGAL COMMAND; ENTER AGAIN" :GOTO 800 

835 N=N+1: GOSUB 920: GOTO 140 

840 PRINT"ENTER PAIR NUMBER TO BE DELETED" ;: INPUT D 

842 GOSUB 920 

860 IF D>N THEN PRINT'PAIR ";D;" NOT FOUND-" :GOTO 805 

865 PRINT"PAIR ";D,-" FOUND AND DELETED" 

870 FOR A=D TO N:L1 (A,0)=L1 (A+1,0) :L1 (A,l) =L1 (A+1,1) :NEXT A:N=N-1:MX(1,0)=0:MX{1 

,1)=0:GOTO 245 
875 INPUT'ENTER THE DATA PAIR NUMBER TO BE CHANGED";D 
880 GOSUB 920 

885 IF D>N THEN PRINT'PAIR ";D;" NOT FOUND-" :GOTO 805 
890 PRINT'PAIR ";D;" FOUND - ENTER NEW VALUES FOR BOTH" ;: INPUT X,Y 
894 GOSUB 930:L1(D,0)=L2(1,0) :L1 (D,1)=L2(1,1) :MX{1 ,0) =0:MX(1,1) =0:GOTO 245 
900 CLS:PRINT"ENTER DATA AS PAIRS - INDEPENDENT VARIABLE FIRST." 
910 PRINT'WHEN LAST PAIR IS ENTERED - TYPE 99,99 AND PRESS ENTER. ": RETURN 
920 X1=0:X2=0:X3=0:Y1=0:Y2=0:Y3=0:Z=0:S=0:S1=0:S2=0:S3=0:S4=0:B=0:B1=0 
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930 IF C=l THEN L2 (1 ,0) =X:L2 (1,1) =Y:RETURN 

940 IP C=2 THEN L2 (1,0) =LOG(X) :L2 (1,1) =LOG(Y) :RETURN 

950 IF C=3 THEN L2 (1 ,0) =LOG (X) :L2 (1,1) =Y:RETURN 

1000 DIMN(350),Z1(14) 

1005 B=1:CLS: PRINT "STANDARD DEVIATION / HISTOGRAM" 

1010 PRINT:PRINT"ENTER YOUR DATA POINTS ONE AT A TIME" 

1015 PRINT"PRESS ENTER AFTER EACH VALUE." 

1020 PRINT: PRINT" AFTER THE LAST POINT IS ENTERED - TYPE 9999 AND PRESS ENTER. 

1025 PRINT B;: INPUT" ";A 

1030 IF A=9999 THEN B=B-1:GOTO1045 

1035 N(B)=A:N1=N1+A*A:N2=N2+A 

1040 B=B+1:GOTO102S 

1045 CLS:SD=SQR((N1-((N2*N2)/B))/B) :AV=N2/B 

1050 PRINT"AVERAGE = ";AV;" STANDARD DEVIATION = ";SD 

1055 GOSUB 1900 

1060 PRINT"MAXIMUM = ";N(B);" NUMBER OF POINTS = "jB 

1065 PRINT'MINIMUM = ";N(1) :PRINT 

1070 K=1:G=0:FOR X=l TO B:E=X-8*INT( (X-l)/8) 

1075 PRINTTAB(4*(E-1));N(X) ; 

1080 IF E>=8 THEN PRINT:K=K+1 

1085 IF K>=14+14*G THEN INPUT'PRESS ENTER TO CONTINUE-" ; AS :G=G+1 

1090 NEXTX: PRINT 

1095 INPUT"DO YOU WANT A HISTOGRAM PRINTED (Y/N)";AS 

1100 IF A$="N" THEN 1400 

1105 IF AS = "Y" THEN 1115 

1110 PRINT'PLBASE ANSWER Y OR N":GOTO1095 

1115 PRINT"ENTER UNIT CELL SIZE - RECOMMEND ABOUT ";SD/2; 

1120 INPUTZ 

1125 IF (N(B)-N(1))/Z>14 PRINT'YOUR CELL SIZE IS TOO SMALL" :GOT01115 

1130 P=Z:W=1:L=0 

1135 IF INT(P/10)=0 THEN P=P*10 : L=L+l:GOTO 1135 

1140 IF L>0 THEN W=1/(10[L) 

1145 PRINT"ENTER UPPER BOUNDRY - ";N(B);" TO ";N(B)+Z; 

1150 INPUTY 

1155 IF Y>N(B)+Z THEN PRINT'TOO LARGE" :GOT01145 

1160 IF Y<N(B) THEN PRINT'TOO SMALL" :G0T01145 

1165 CLS:PRINT"WORKING":Q=l:D=Y 

1170 FOR X=B TO 1 STEP -1 

1172 R=Y-N(X) 

1175 IF R<Z THEN Zl (Q) =Z1 (Q) +1 

1180 IF R>=Z THEN Y=Y~Z :Q=Q+l:GOT01172 

1185 NEXTX 

1190 CLS:GOSUB1950:FOR X=0 TO 44:SET(27 ,X) :NEXTX 

1195 FORQ=l TO 14 

1200 PRINT8960-(64*Q),D-(Z*Q)+W;"-"!D-(Z*(Q-1)); 

1205 FOR X=27 TO 27+ Z1(Q) :SET(X,46-(3*Q) ) :NEXTX 

1210 NEXTQ:FOR Q=l TO 14:PRINTil020-64*Q,Zl(Q)/F:NEXTQ 

1215 PRINT6960,"";:GOTO1400 

1400 INPUT"COMHAND";C$ 

1405 IF CS="HELP"THEN1440 

1410 IF C$="END" THEN1475 

1415 IF CS="DELETE" THEN1495 

1420 IF C$="ADD" THEN 1525 

1425 IF C$="CHANGE" THEN 1530 

1430 IF CS="LIST" THEN1560 

1435 PRINT'ILLEGAL COMMAND; ENTER AGAIN" :GOTO1400 

1440 PRINT"VALID COMMANDS ARE -" 

1445 PRINTTAB(20)"HELP" 

1450 PRINTTAB(20)"LIST" 

1455 PRINTTAB(20) "DELETE" 

1460 PRINTTAB(20)"ADD" 

1465 PRINTTABI20) "CHANGE" 

1470 PRINTTAB(20)"END":GOTO1400 

1475 INPUT"ARE YOU READY TO STOP? DATA SAVED";F$ 

1480 IF LEFTS <F$,1)="Y" THEN RUN4 

1485 IF LEFT?(F$,1)="N" THEN 1400 

1490 PRINT"ANSWER YES OR NO. " :GOT01475 

1495 INPUT'ENTER VALUE TO BE DELETED"; A 

1500 FOR X=l TO B 

1505 IF A=N(X) THEN 1520 

1510 NEXTX 

1515 PRINT"VALUE NOT FOUND -":GOTO1400 

1520 C=X:FOR X=C TO B:N(X) =N(X+1) :NEXT X:B=B-1:GOTO1600 

1525 CLS:B=B+l:FOR Q=l TO 14:Z1(Q) =0:NEXTQ:GOTO1010 

1530 INPUT"ENTER VALUE TO BE CHANGED";A 

1535 FOR X=l TO B 

1540 IF A=N(X) THEN 1550 

1545 NEXT X:PRINT"VALUE NOT FOUND -":GOTO 1400 

1550 PRINTN(X),-" FOUND - ENTER NEW VALUE"; 

1555 INPUT A:N8X)=A:GOTO1600 

1560 CLS:FOR Q=l TO 14 :Z1 (Q) =0:NEXTQ:GOTO 1060 

1600 N1=0:N2=0:FOR X=l TO B 

1605 N1=N1+N(X)*N(X) :N2=N2+N(X) 

1610 NEXTX:GOTO1045 

1900 G=B 

1905 IF G<=1 THEN RETURN 

1910 G=INT(G/2):M=B-G 
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1915 F=0:FOR 1=1 TO M 

1920 P=I+G 

1925 IF N(I)<=N(P) THEN 1935 

1930 T=N(I):N(I)=N(P):N(P)=T:F=1 

1935 NEXTI 

1940 IF F>0 THEN 1915 

1945 GOT019B5 

1950 Z2=0:FOR Q=l TO 14:IF Z2<Z1(Q) THEN Z2=Z1(Q) 

1955 NEXTQ 

196B Z3=INTU00/Z2) 

1965 IF Z3<1 THEN F=.5:GOT01995 

1970 IF Z3=l THEN RETURN 

1975 IF Z3<=5 AND Z3>=3 THEN F=3:GOT01995 

198B IF Z3=2 THEN F=2:GOT01995 

1985 IF Z3>10 THEN F=1B:G0T01995 

1990 IF Z3>5 AND Z3<10 THEN F=5 

1995 FOR Q=l TO 14:Z1(Q) =F*Z1 (Q) : NEXTQ : RETURN 

2B0B CLS:CLEAR1B:PRINT"X-BAR, R PLOT": PRINT 

2005 INPUT'HOW MANY DATA POINTS WILL BE AVERAGED" fC 

2010 PRINT"ENTER DATA IN SETS OF "jC 

2B15 PRINT'A RUNNING AVERAGE WILL BE SHOWN ON EACH SET" 

2020 PRINT'IF ANY SET HAS LESS THAN" ;C( "POINTS, ENTER THE RUNNING" 

2025 PRINT'AVERAGE TO MAKE UP THE ";C; "POINTS." 

2030 PRINT: PRINT"AFTER THE LAST SET IS ENTERED - TYPE 9999 AND PRESS ENTER." 

2035 PRINT: INPUT'PRESS ENTER TO BEGIN DATA ENTRY",-A$ 

2040 DIM N1(100,C+1) 

2045 T$="MI.##":N=1:PRINT:PRINT"SET NO." 

2050 A=1:SM=0:FOR Al=l TO C:M(A1)=0:NEXTA1 

2055 PRINT"! ";N;" )", "RUNNING AVERAGE" 

2060 IF A=C+1 THEN A=l:GOTO 2085 

2065 INPUT MIA) : PRINT" ";: FOR Q=l TO A:SM=SM+M(Q) :NEXTQ:SM=SM/A 

2070 IF MCA) =9999 THEN N=N-1:GOTO2100 

2075 PRINTe914,SM:Nl(N,A)=M(A) :N1(N,0)=SM 

2080 A=A+1:SM=0:GOTO2060 

2085 N=N+l:GOTO 2055 

2100 CLS:G=0:FOR A = 1 TO N 

2105 PRINTA;"~";:FOR AC=1 TO C:PRINTN1 (A, AC) ; :NEXTAC:PRINT 

2110 IF A>=12+12*G THEN INPUT'PRESS ENTER TO CONTINUE LIST-" ,- A$:G=G+1 

2120 NEXT A 

2125 INPUT'DO YOU WISH TO CHANGE ANY DATA (Y/N)";A$ 

2130 IF AS="Y" THEN 2200 

2132 IF AS="N" THEN2135 

2134 PRINT"ANSWER Y OR N":G0TO2125 

2135 FOR A=l TO N 
2140 GOSUB 2900 

2145 MN=N1(A,1):MX=N1(A,C):N1(A,C+1)=MX-MN 

2150 NEXT A 

2155 N4=0:N5=0:FOR A=l TO N 

2160 N4=N4+N1(A,0) :N5=N5+N1 (A,C+1) :NEXTA 

2165 N6=N4/N:N7=N5/N 

2170 GOTO 2300 

2200 CLS:INPUT"DO YOU NEED TO LIST AGAIN" ;A$ 

2202 IF A?="N" THEN 2208 

2204 IF A$="Y" THEN 2100 

2206 PRINT"ANSWER Y OR N":GOTO2200 

2208 INPUT"ENTER SET NUMBER TO BE CHANGED" ; M 

2210 FOR A=l TO C:PRINT Nl (M, A) ; :NEXT A 

2215 PRINT: PRINT"ENTER NEW VALUES FOR ALL POINTS" 

2220 SM=0:R9=0 

2225 PRINT"! ";M;" )", "RUNNING AVERAGE" 

2228 FOR A=l TO C 

2230 INPUT M(A):FOR Q=l TO A:SM=SM+M(Q) :NEXT Q:SM=SM/A 

2235 R=343+R9*64 

2240 PRINT@R,SM:N1(M,A)=M(A) :N1(M,0)=SM 

2245 SM=0:R9=R9+1 

2250 NEXT A 

2260 GOT02125 

2300 CLS:PRINT847 5, "WORKING" :R1=0:R2=0:R3=0:R4=0 

2305 FOR A=l TO N:IF RKN1(A,0) THEN R1=N1(A,0) 

2310 IF R3<N1(A,C+1) THEN R3=N1(A,C+1) 

2315 NEXT A:R2=R1:R4=R3 

2320 FOR A=l TO N:IF N1(A,0)<R2 THEN R2=N1(A,0) 

2325 IF N1(A,C+1)<R4 THEN R4=N1(A,C+1) 

2330 NEXTA 

2332 N8=N:IF N>50 THEN 2400 

2335 CLS:FOR A=0 TO 44:SET(26 ,A) :NEXT A:FOR A=26 TO 127 :SET(A, 44) :SET(A,33) :NEXT 

A 
2340 PRINT8960," 10 20 30 40 50" 

2345 PRINT6839 , "R" ; : PRINT8390 , "X-BAR" ; 

2350 H1=30/(R2-R1):J1=-R1*H1:H2=10/(R4-R3) :J2=34-R3*H2 

2355 IF N>50 THEN 2400 

2356 FOR A=l TO N 

2358 IF N1(A+L*50,0)<=0 THEN 2365 

2360 SET(26+2*A,N1(A+L*50,0)*H1+J1) :SET(26+2*A,N1 (A+L*50,C+1) *H2+J2) :NEXTA 
2365 PRINT@645,"";:PRINT USING T$;R2; : PRINTS5 ,"";: PRINT USINGTS;R1; : PRINTS773 , "" 
;: PRINT USINGT$;R3; 
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2375 PRINT664, "PRESS"; :PRINT6128, "ENTER TO"; ; PRINT8192, "CONTINUE"; : INPUT AS:IF N 

N>0 THEN NN=NN-50:L=L+1:GOTO2420 

2388 CLS:INPUT"DO YOU WANT TO LIST X-BAR AND R (Y/N)";A$ 

2385 IP AS="N" THEN 2680 

2398 IP AS="Y" THEN 2500 

2395 PRINT"PLEASE ANSWER Y OR N":GOTO2380 

2408 CLS:N9=N:N=50:NN=N9-50:PRINT"N IS GREATER THAN 50. ONLY 50 POINTS WILL BE 

PLOTTED." 

2485 PRINT"THE OTHER POINTS WILL BE PLOTTED 58 AT A TIME ON DEMAND." 

2410 INPUT'PRESS ENTER TO CONTINUE-" ;A$:GOT02335 

2428 IP NN<0 THEN N=50 :GOT02335 

2425 N=58:NN=NN-50:GOTO 23 35 

2500 N=N8:CLS:PRINT"SET NO. ", "X-BAR", "R" :G=8 

2505 FOR A=l TO N:PRINTA,N1 (A, 8) ,N1(A,C+1) 

2515 IFA>=14+G*14 THEN INPUT'PRESS ENTER TO CONTINUE-" ; AS :G=G+1 

2528 NEXTA:PRINT"AV X-BAR = ";N6;" AV R = " ;N7 : INPUT"PRESS ENTER TO CONTINUE 

-";AS 
2525 ON C GOSUB 2700,2700,2705,2710,2715,2720,2725,2730,2735,2748 
2530 PRINT"X-BAE UPPER CONTROL LIMIT = ";N6+A2*N7 
2535 PRINT"X-BAR LOWER CONTROL LIMIT = ";N6-A2*N7 
2540 PRINT:PRINT"R UPPER CONTROL LIMIT =";D4*N7 
2545 PRINT"R LOWER CONTROL LIMIT =";D3*N7 
2550 INPUT"PRESS ENTER TO CONTINUE";A? 

2600 INPUT"DO YOU WANT TO PLOT - ADD - CHANGE - LIST - END";A$ 
2602 L=0:IF A$="PLOT" THEN 2332 

2604 IF A$="LIST" THEN 23 80 

2605 IF AS="Y" THEN 2332 

2606 IF A$="CHANGE" THEN 2125 
2608 IF A?="ADD" THEN 2620 
2610 IF A$="END" THEN RUN 4 

2612 PRINT"ILLEGAL COMMAND; ENTER AGAIN" :GOTO2600 

2620 N=N+l:PRINTe768,"SET NO. " :GOTO2050 

2708 A2=l. 88 :D3=0:D4=3. 267: RETURN 

2705 A2=1.023:D3=0:D4=2.575:RETURN 

2710 A2=.729:D3=0:D4=2.283:RETURN 

2715 A2=.577:D3=0:D4=2.115:RETURN 

27 20 A2=.483:D3=8:D4=2.004:RETURN 

2725 A2=.419:D3=.076:D4=1.924:RETURN 

27 30 A2=.373:D3=.136:D4=1.864:RETURN 

2735 A2=.337:D3=.184:D4=1.816:RETURN 

2740 A2=.308:D3=.223:D4=1.777:RETURN 

2900 G=C 

2905 IF G<=1 THEN RETURN 

2910 G=INT(G/2) :M=C-G 

2915 F=0:FOR 1=1 TO M:P=I+G 

2920 IF N1(A,I)<=N1{A,P) THEN 2930 

2925 T=N1(A,I) :N1 (A, I) =N1 (A,P) :N1 (A,P) =T:F=1 

2930 NEXT I 

2935 IF F>0 THEN 2915 

2940 GOTO 2905 

3008 CLS:PRINT"THIS SUB-ROUTINE IS OPEN":FOR A=l TO 10B0:NEXTA:RUN4 
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ASHRAE: by Liccuardello & Davies Associates 



This unique program gives 
design specifications for the 
design of residential and com- 
mercial heating and cooling 
systems. Full Society specifica- 
tions are adhered to. A useful 
program for architectural and 
consulting firms. 
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HIT m KEY TO COKIIM 



10 CLEAR 100:DEFSTR A-H:DEFINT I-N:DEFSNG 0-Z:MW=24:DIMWA(9) ,UW(9,2) ,YD(MW) ,YT(M 

W) ,YB(MW),ID(MW),IT(MW),WW(MW),UG(3,2),AM(9),AN(9),TE(12,7) ,TA(3,6,5,2) ,SL( 

5,7) :CLS:GOSUB8500: PRINT: INPUT"RESIDENCE IDENTIFIER" ;AR:F0RI=1T09:READAM( I) 

,AN(I) :NEXTI 
230 DATA NORTH, N, NORTHEAST, NE, EAST, E, SOUTHEAST, SE, SOUTH, S, SOUTHWEST, SW, WEST, W, NO 

RTHWEST , NW , PARTITION , PA 
250 PRINT: INPUT'CASE IDENTIFIER" : iBR: PRINT :PRINT"WEATHER CONDITIONS: ": INPUT" DES 

IGN HIGH";TH:INPUT" DESIGN LOW" ;TL: INPUT" DESIGN DAILY RANGE";TR:PRINT:IN 

PUT"SITE LATITUDE, DEGREES" ;ZL 
300 CLS:PRINT"OPAQUE WALL (6 DOOR) INPUT" : PRINT :PRINT"FOR EACH WALL EXPOSURE, IN 

PUT:":PRINT" EXPOSURE (NORTH, NORTHEAST, ETC. OR PARTITION) ": PRINT" WALL AR 

EA, SQ. FT.": PRINT" SUMMER U-VALUE" : PRINT" WINTER U-VALUE" 
400 PRINT'AN EXPOSURE OF '0' SIGNIFIES THE END OF WALL DATA" :GOSUB9000 :CLS 
440 PRINT :INPUT"EXPOSURE";BM:IFBM="0"THEN500 
450 F0RI=1T09 : IFBM=AM ( I) ORBM=AN ( I ) THEN455 
452 NEXTI:GOTO440 
455 I1=I:INPUT"WALL AREA, SQ. FT. ";WA(I1) : INPUT"SUMMER U-VALUE" ;UW( II ,1) : INPUT"W 

INTER U-VALUE";UW(I1,2) :GOTO440 
500 CLS:J=1 
510 PRINT TAB(5) AM( J) , : FORI=J+lTOJ+3 : PRINTAM(I) , :NEXTI :PRINT"AREA" ; : FORI=0TO3 : P 

RINTWAU+I) , :NEXTI:PRINT"U— S" ; : FORI=0TO3 : PRINTUW( J+1, 1) , :NEXTI:PRINT"U— W" 

;:FORI=0TO3:PRINTUW(J+I,2) , :NEXTI 
600 PRINT:IFJO5THENJ=5:GOTO510 
605 PRINT TAB(5) AM(9) :PRINT"AREA";WA(9) :PRINT"U— S" jUW( 9,1) :PRINT"U-*rW" ;UW(9,2) 

: PRINT: GOSUB9000: IFIW=2THEN900 
630 CLS:PRINT"W INDOW INPUT" 

640 PRINT:PRINT"FOR EACH WINDOW, INPUT: ":PRINT" * WINDOW DIRECTION" :PRINT" * 
WINDOW TYPE":PRINT" 1 = SINGLE PANE GLASS" : PRINT" 2 = DOUBLE P 

ANE GLASS" :PRINT" 3 = DOUBLE PANE, HEAT ABSORBING" 
700 PRINT " * WINDOW AREA, SQ. FT. ":PRINT" * LENGTH OF OVERHANG" : PRINT" * 

DISTANCE FROM TOP OF WINDOW TO OVERHANG" :PRINT" * DISTANCE FROM BOTTOM OF 
WINDOW TO OVERHANG" :PRINT"A WINDOW DIRECTION OF '0' ENDS WINDOW INPUT" 
740 GOSUB9000:CLS:NW=1 

770 PRINT: PRINT"WINDOW NUMBER" ;NW: INPUT"WINDOW DIRECTION" ;BM: IFBM="0"THEN890 
785 FOR 1=1 TO 8:IFBM=AM(I) ORBM=AN(I) THEN790 
7 86 NEXTI:GOTO770 
790 ID(NW)=I:IFWA(I)O0THEN800 
796 PRINT'NO WALL IN THIS DIRECTION" :GOT07 80 
800 INPUT "WINDOW TYPE" ; IT(NW) : IFIT(NW)<10RIT(NW) >3THEN800 
8.10 INPUT"WINDOW AREA";WW(NW) :INPUT"OVERHANG LENGTH, FT. " ; YD (NW) : IFYD (NW) =0THEN8 

70 
850 INPUT"TOP OF WINDOW TO OVERHANG, FT. " ;YT (NW) : INPUT'BOTTOM OF WINDOW TO OVERH 

ANG, FT.";YB(NW) 
870 NW=NW+l:GOTO 770 
890 NK=NW-1 
900 CLS:PRINT"THERE ARE" ;NW; "WINDOWS" : PRINT : F0RI=1T08 :NX=0: FORJ=lTONW: IFID( J) =IT 

HENNX=NX+1 
950 NEXTJ:IFNX=0THEN970 
960 PRINT NX;"FACE ";AM(I) 
970 NEXTI:GOSUB9000:IFIW=2THEN2860 
990 CLS:INPUT"ROOF PLAN AREA, SQ. FT. ";RA: INPUT"ROOF SUMMER U-VALUE" ;RS: INPUT"RO 

OF WINTER U-VALUE", -RW 
1020 PRINT:PRINT"INPUT FLOOR TYPE: " :PRINT" 1 = CRAWL SPACE" :PRINT" 2 = S 

LAB-ON-GRADE" : INPUT JF : IFJF=2THEN1100 
1070 INPUT"FLOOR PLAN AREA, SQ. FT. " ;SA: INPUT"FLOOR SUMMER U-VALUE" ; SS : INPUT"FLO 

OR WINTER U-VALUE ";SW 
1100 PRINT:PRINT "INPUT GENERAL TYPE OF WALL CONSTRUCTION: " :PRINT" 1 = FRAME 

":PRINT" 2 = MASONRY" : INPUT JW:PRINT: INPUT'IS THE ROOF DARK (1) OR LIGH 
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T (2)";JR:JR=JR+4:PRINT:INPUT"VOLUME OF CONDITIONED SPACE" ;VL: INPUT'AIR CHA 

NGES PER HOUR";VC 
H6B FORJ=1T07:FORI=1T012:READTE(I,J> :NEXTI,J 

1210 DATA 17.6,13.6,22.6,18.6,13.6,27.6,23.6,18.6,28.6,23.6,28.6,33.6 
1220 DATA 10.3,6.3,15.3,11.3,6.3,20.3,16.3,11.3,21.3,16.3,21.3,26.3 

1225 DATA 9,5,14,10,5,19,15,10,20,15,20,25 

1226 DATA 2.5,0,7.5,3.5,0,12.5,8.5,3.5,13.5,8.5,13.5,18.5 
1230 DATA 38,34,43,39,34,48,44,39,49,44,49,54 

1240 DATA 30,26,35,31,26,40,36,31,41,36,41,46 

1250 DATA 9,5,14,10,5,19,15,10,20,15,20,25 

1280 IFTH>89THEN1310 

1290 IFTR<15THENJC=1ELSEJC=2 

1295 TD=TH-85:IFTD<0THENTD=0 

1300 GOTO1500 

1310 IFTH>94THEN1340 

1320 IFTR<15THENJC=3ELSEIFTR<25THENJC=4ELSEJC=5 

1325 TD=TH-90:GOTO1500 

1340 IFTH>99THEN1370 

1350 IFTR<15THENJC=6ELSEIFTR<25THENJC=7ELSEJC=B 

1355 TD=TH-95:GOTO1500 

1370 IFTH>104THEN1400 

13 80 IFTR<25THENJC=9ELSEJC=10 

1385 TD=TH-100:GOTO1500 

1400 IFTH<109THENJC=11ELSEJC=12 

1410 TD=0:IFJCO12THENTD=TH-105 

1500 UG(1,1)=1.04:UG(1,2)=1.1:UG(2,1)=.65:UG(2,2)=.62:UG(3,1)=.51:UG{3,2)=.43 

1510 FORL=1T02:FORI=1T03:FORJ=1T06:FORK=1T05:READTA(I,J,K,L) :NEXTK,J,I,L 

1600 DATA 23,56,81,70,40,27,60,85,74,44,31,64,89,78,48 

1610 DATA 35,68,93,82,52,38,71,96,85,55,44,77,102,91,61 

1620 DATA 19,46,68,59,33,21,48,70,61,35,24,51,73,64,38 

1630 DATA 26,53,75,66,40,28,55,77,68,42,30,57,79,70,44 

1640 DATA 12,27,42,35,19,14,29,44,37,21,17,32,47,40,24 

1650 DATA 19,34,49,42,26,21,36,51,44,28,23,38,53,46,30 

1660 DATA 15,32,48,40,23,19,36,52,44,27,23,40,56,48,31 

1670 DATA 27,44,60,52,35,30,47,63,55,38,36,53,69,61,44 

1680 DATA 12,27,42,35,20,14,29,44,37,22,17,32,47,40,25 

1690 DATA 19,34,49,42,27,21,36,51,44,29,23,38,53,46,31 

1700 DATA 9,20,30,24,15,11,22,32,26,17,14,25,35,29,20 

1710 DATA 16,27,37,31,22,18,29,39,33,24,20,31,41,35,26 

17 40 HL=1 : MJ=INT ( (TH-85 ) /5) +1 : IFMJ<1THENMJ=1 

1770 XJ=0:IFTH<=85ORTH>=110THEN17 88 

1780 TT=(MJ-l)*5+85:XJ=(TH-TT)/5 

1788 GOSUB4000 

1830 WG=0:WX=0:TX=TE(JC,JW)+TD 

1835 CLS: PRINT"COOLING LOADS: ";AR;° / " ;BR: PRINT'WINDOW GAINS (BTU/ilR) " , "WALL 

GAINS (BTU/HR)":J=98:JK=0 
1850 F0RI=1T09 : TY=TX : IFI=9THENTY=TE ( JC , JW+2 ) +TD 
1855 IFWA(I)=0THEN1870ELSEWH=INT(WA(I)*UW(I,l)*TY+.5) 
1860 J=J+64:IFJ=418THENJK=J-64:J=178 

1862 BM=AN(I) : IFLEN (AN ( I) )<2THENBM=BM+" " 

1863 PRINTM,BM;:PRINTUSING"»»»#,#»«";WH;:WG=WG+WH:WX=WX+WA(1) 
1870 NEXT I 

1880 IFJK=0THENJK=J 

1910 RG=INT((TE(JC,JR)+TD)*RA*RS+.5) :YG=0:K=66 

1950 FORI = lTONW : WX=WX+WW ( I ) : IFID ( I ) >2ANDID ( I ) <8THEN2025 

1975 HK=ID(I) :IFMK>5THENHK=10-ID(I) 

1990 TT=TA(IT(I) ,HJ,MK,ML) : IFXJO0THENTT=TT+XJ* (TA(IT( I) ,MJ+1,MK,ML) -TT) 

2000 YH=INT(WW(I)*UG(IT(I) ,l)»TT+.5) :GOTO2200 

2025 PS=0:IFYD(I)=0THEN2070 

2030 PD=SL(ID(I)-2,JZ) 

2040 PD=SL(ID(I)-2,JZ) : IFYLO0THENPD=PD+YL*(SL(ID(I) -2,JZ+1) -PD) 

2050 PD=PD*YD(I)-YT(I) : PS=PD/ (YB(I) -YT(I) ) : IFPS<0THENPS=0 

2061 IFPS<0THENPS=0 

2065 IFPS>1THENPS=1 

2070 MK=ID(I) :IFMK>5THENMK=10-ID(I) 

2080 TT=TA(IT(I) ,MJ,MK,ML) : IFXJO0THENTT=TT+XJ* (TA( IT( I) ,HJ+1 ,HK,HL) -TT) 

2090 YH=INT((1-PS)*WW(I)»UG(IT(I),1)*TT+.5):IFPS=0THEN2200 

2110 TT=TA(IT(I) ,MJ,1,ML) : IFXJO0THENTT=TT+XJ* (TA ( IT( I) ,MJ+1 ,1 ,ML) -TT) 

2120 YH=YH+INT(PS*WW(I)*UG(IT(I),l)*TT+.5) 

2200 YG=YG+YH:K=K+64:IFK>890THENK=146 

2203 PRINTM," "; :PRINTUSING"#f It , ##l" ,-I;YH; 

2205 NEXT I 

2220 YF=0:IFJF=2THEN2260 

2240 YF=INT(SA*SS*(TE(JC,7)+TD)+.5) 

2260 IFTH>100THEN2290 

2270 TT=0.7+(TH-85)/15*1.2:GOTO2350 

2290 IFTH>105THEN2320 

2300 TT=1.9+(TH-100)/5*0.3 

2310 GOTO 2350 

2320 TT=2.2+(TH-105)/5*0.4:IFTT>2.6THENTT=2.6 

2350 YI = INT(TT*WX+.5) :J=JK+126 : PRINTM, "TOTAL GAINS" ; : J=J+66 : PRINTM, "WALLS" , :PR 

I NTUSING"SS#f,»#S";WG;:J=J+64: PRINTM, "WINDOWS", :PRINTUSING"#S## , ###" ; YG; : J 

=J+64: PRINTM, "ROOF", : PRINTUSING" ##H ,»#*", -RG; 
2375 IFYF >0THENJ=J+64: PRINTM, "FLOOR", : PRINTUSING" ###S , f##";YF ; 
2377 J=J+64: PRINTM," INFILTRATION", : PRINTUSING" ###»,##»" ;YI ; :TG=WG+RG+YG+YF+YI: J 

=J+70: PRINTM, "TOTAL", : PRINTUSING" ####,###" J TG; 
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2420 YC=INT(TG/1000+.5)/10:PRINTS960, "APPROXIMATE A/C SIZE: ";YC; "TONS" ; :GOSUB900 


2500 CLS:PRINT"HEATING LOADS: ";AR;" / ";BR:PRINT"WINDOW LOSSES (BTU/HR) " "WALL 

LOSSES (BTU/HR) ":J=98:JK=0 
2510 TT=70-TL:WL=0:FORI=1TO9:IFWA(I)=0THEN2550 
2535 TS=TT:IFI=9THENTS=TS/2 
2540 WM=INT(UW(I,2)*WA(I)*TS+.5) :WL=WL+WH 
2545 J=J+64:IFJ=418THENJK=J-64:J=17 8 

2547 BM=AN(I) :IFLEN(AN(I) )<2THENBM=BM+" " 

2548 PRINT9J,BM;:PRINTUSING"###»,t##";WM; 
2550 NEXT I 

2560 IFJK=0THENJK=J 

2570 RL=INT(RW*RA*TT+.5) : ZG=0: K=66 :FORI=1TONW 

2610 ZH=INT(WW(I)*UG(IT(I),2)*TT+.5) :ZG=ZG+ZH 

2615 K=K+64:IFK>890THENK=146 

2617 PRINT6K," "; :PRINTUSING"H #«, ###";I;ZH; 

26 20 NEXT I 

2625 J=JK+126:PRINT@J, "TOTAL LOSSES"; :J=J+66 :PRINT6J, "WALLS", :PRINTUSING"#t M, I I 

»";WL;:J=J+64:PRINTej, "WINDOWS", :PRINTUSING"##t#,###";ZG; : J=J+64:PRINT8J, "R 

OOF",:PRINTUSING"#»*#,###";RL;:ZF=0:IFJF=2THEN26 80 
2660 ZF=INT(SA*SW*TT/2+.5):J=J+64:PRINTej,*FL00R",:PRINTUSING"#»M,l##",-ZF; 
2680 ZI=INT(0.018*VL*VC*TT+.5) :J=J+64 :PRINT6J, "INFILTRATION", :PRINTUSING"####, it 

t";ZI;:ZT=WL+RL+ZG+ZF+ZI:J=J+70:PRINTej, "TOTAL", :PRINTUSING"#tt#,#M";ZT;:X 

T=INT(ZT*1.5+.5) :PRINT@896,"WITH 50* MARGIN: ", -XT; "BTU/HR"; 
2810 XT=INT(ZT*1.3+.5):PRINTe960,"WITH 30* MARGIN: ";XT; "BTU/HR"; :GOSUB9000 
2850 CLS:PRINT"FOR PARAMETRIC ANALYSES. . . " : INPUT'CASE IDENTIFIER";BR 
2860 PRINT:PRINTTAB(5)"1 = ROTATE BUILDING" :PRINTTAB(5) "2 = CHANGE WINDOW PARAME 

TERS":PRINTTAB{5)"3 = CHANGE WALL U-VALUES" :PRINTTAB{ 5) "4 = CHANGE ROOF U-V 

ALUE":PRINTTAB(5) "5 = CHANGE FLOOR U-VALUE" 
2915 PRINTTAB(5)"6 = CHANGE NUMBER OF AIR CHANGES PER HOUR" :PRINTTAB(5) "0 = END 

OF CHANGES" :INPUT"INDEX";IJ:ONIJ+1GOTO1830, 5000, 5500, 6000, 6500, 7000 ,7500 
4000 F0RJ=1T07:F0RI=1T05:READSL(I, J) :NBXTI,J 
4090 DATA 0.8,1.9,10.1,1.9,0.8 
4100 DATA 0.8,1.6,5.4,1.6,0.8 
4110 DATA 0.8,1.4,3.6,1.4,0.8 
4120 DATA 0.8,1.3,2.6,1.3,0.8 
4130 DATA 0.8,1.1,2,1.1,0.8 
4140 DATA 0.8,1,1.7,1,0.8 
4150 DATA 0.8,0.9,1.4,0.9,0.8 

4170 JZ=INT( (ZL-25)/5)+l:IFJZ>7THENJZ=7ELSEIFJZ<lTHENJZ=l 
4190 YL=0: IFZL<=250RZL>=55THENRETURN 
4200 YY=(JZ+4)*5:YL=(ZL-YY)/5:RETURN 
5000 PRINT: PRINT'ROTATIONS ARE MADE CLOCKWISE IN MULTIPLES OF 45 DEGREES" : INPUT' 

INPUT NUMBER OF DEGREES OF ROTATION" ; IK : IK=IK/45 
5040 FORLL=lTOIK:XX=WA(8) :UU=UW(8,1) :UV=UW(8,2) :FORI=8T02STEP-l:WA(I) =WA(I-1) -Ul 

(1,1) =UW( 1-1,1) :UW( 1,2) =UW( 1-1,2) :NEXTI:WA(1) =XX :UW(1,1) =UU:UW(1 ,2) =UV:NEX'I 

5110 FORI=lTONW:ID(I)=ID(I)+IK:IFID(I)>8THENID(I)=ID(I)-8 

5140 NEXTI:IW=2:GOTO500 

5500 CLS 

5510 PRINT: INPUT'WINDOW NUMBER" , -Nil : IFNU=0THEN2860 

5520 IFNU>NWTHEN5510 

5525 PRINT'CURRENT DATA: " :PRINTTAB (2) "DIRECTION" ,AM ( ID (NU) ) : PRINTTABI 2) "TYPE" , I'l 

(NU) :PRINTTAB(2) "OVERHANG", YD(NU) :IFYD(NU) =0THEN5530 
5527 PRINTTABI 2) "TOP DIST. ",YT(NU) :PRINTTAB(2) "BOTTOM DIST. " , YB(NU) 
5530 PRINT: INPUT"WINDOW TYPE" ; IT(NU) : IFIT(NUX10RIT(NU) >3THEN5530 
5560 INPUT"OVERHANG LENGTH, FT. " ; YD (NU) : IFYD (NU) =0THEN5510 
5580 INPUT'TOP OF WINDOW TO OVERHANG, FT. " ; YT (NU) : INPUT"BOTTOM OF WINDOW TO OVE 

HANG, FT. ";YB(NU) :GOTO5510 
6000 CLS:INPUT"EXPOSURE";BM:IFBM="0"THEN2860 
6010 FORI=1TO9:IFBM=AM(I)ORBM=AN(I)THEN6030 
6020 NEXTI:GOTO6000 

6030 IK=I:INPUT"SUMMER U-VALUE" ;UW( IK, 1) : INPUT"WINTER U-VALUE" ;UW( IK, 2) :GOTO6000 
6500 CLS:INPUT"SUMMER U-VALUE";RS: INPUT"WINTER U-VALUE" ;RW:GOTO2860 
7000 CLS:INPUT"SUMMER U-VALUE";SS: INPUT"WINTER U-VALUE";SW:GOTO2860 
7500 INPUT"NUMBER OF AIR CHANGES PER HOUR" ;VC:PRINT:GOTO2860 
8500 FORI=15360TO15871:POKEI,191:NEXTI 

8510 PRINT@71," ASHRAE RESIDENTIAL LOADS" 
8520 PRINT6550," ":RETURN 
9000 PRINT61000,"HIT ANY KEY TO CONTINUE" ;: FORJ=1T099 :NEXTJ: PRMT81000 , STRINGS (2 

3," ") ;:FORJ=1TO99:NEXTJ:IFINKEY$=""THEN9000ELSERETURN 
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PLUMBING DESIGN: by Liccuardello & Davies Associates 



Similar to the Ashrae pro- 
gram, but applicable to plumb- 
ing design requirements. Flow 
rates, nodal configurations, head 
levels, etc. are all taken into ac- 
count in calculating pipe size 
and other variables in the sys- 
tem. Most useful to the private 
contractor or design consultant. 



5 DEFINTI-N:CLEAR200 

IB GOSUB2500' DIMENSION VARIABLES 

15 Z$=STRINGS(160,191) 

20 CLS:PRINTZ$;ZS; 

22 PRINT620," OPEN SYSTEM"; 

24 PRINTO144," PLUMBING DESIGN"; 

26 PRINT6280," PROGRAM ";: PRINTe383," "; 

30 INPUT'TOTAL NUMBER OF NODES", -NN 

40 PRINT: INPUT'SYSTEM PRESSURE AT INLET (NODE 1) IN PSI";PP 

45 GOSUB7000' PILL IN PIPE SIZES 

50 CLS: PRINT" INPUT NODAL CONNECTIONS IN THE FORM 'NN,MM'" 

60 NC=0 

70 INPUT"NN,MM";N1,M1 

80 IFN1=0THEN100 

90 NC=NC+1: II (NC)=N1:JJ(NC)=M1: PRINT :GOTO70 

100 CLS: PRINT" INPUT LENGTHS BETWEEN NODES, IN FEET" 

110 FORI=1TONC:GOSUB3000:INPUTXL(I) :NBXTI 

115 CLS:PRINT"ELEVATION ABOVE NODE 1 IN FEET": PRINT 

116 FORI=2TONN:PRINT"8 NODE";I; : INPUTEL(I) :NEXTI 
120 GOSUB2000' SET UP FLOW PATH MATRIX 

130 CLS:INPUT"DO YOU WISH TO INPUT DISCHARGE RATES (D) OR FIXTURE UNITS (F)";A$ 
135 IFA$="D"THEN140ELSECLS:PRINT"INPUT THE NUMBER OF FIXTURE UNITS" : PRINT:GOT015 


140 CLS: PRINT" INPUT THE REQUIRED DISCHARGE RATES IN GPM":PRINT 
150 FORI=lTOIP:PRINT"6 NODE" ;LP( I, 1) ; : INPUTF 
160 F0RJ=1T0NC:IFJJ(J)=LP(I,1)ANDII(J)=LP(I,2)THEN17 4 
170 NEXTJ 

174 IFA$="D"THEN180 

175 PRINTTAB(10);:INPUT"FLUSH VALVES (1) OR FLUSH TANKS (2)";K 

176 IFK=1ANDF<5THENF=5 

177 AP(I)=8:IFK=1THENAP(I)=15:F=-F 
180 FL(J)=F 

190 NEXTI 

200 CLS:INPUT"MAXIMUM VELOCITY, FPS";VM 

210 IFA$="F"THEN215 

211 PRINT: INPUT"MINIMUM PRESSURE, PSI";PM 

212 F0RI=1T0IP:AP(I)=PM:NEXTI 

215 GOSUB7500' CHECK FOR PROBLEMS DUE TO TOO GREAT EL. CHANGE 

220 FORI=lTOIP 

222 IX=LP(I,1) :IY=LP(I,2) 

224 F0RJ=1T0NC:IFIX=JJ(J)ANDIY=II(J)THEN228 

226 NEXTJ 

228 FX=FL ( J ) : FY=ABS ( FX ) 

230 10=2 

240 IFLP(I,IQ)=1THEN300 

250 IX=LP ( I, IQ):IY=LP( 1,10+1) 

260 FORJ=1TONC:IFIX=JJ(J)ANDIY=II(J)THEN280 

270 NEXTJ 

280 FZ=FL(J) :FL(J)=ABS(FL(J)) +FY : IFFZ<0ORFX<0THENFL ( J) =-FL( J) 

290 IQ=IQ+1:GOTO240 

300 NEXTI 

310 IFA$="F"THENGOSUB6500' ADJUST FROM FIXTURE UNITS TO GPM 

360 CLS:PRINT"SYSTEM DESIGN FLOWS ARE:":PRINT 

370 FORI=lTONC:GOSUB3000:PRINTUSING"S##f .«#";FL(I) ,~:PRINT" GPM" 

375 IFI=NCORI=INT(I/10)*10THENGOSUB90 00:CLS 

380 NEXTI 

410 ■ ASSUME MAX VELOCITY IN ALL PIPES. 

420 ■ INPUT VALVES, FITTINGS, ETC. 

500 ■ CALCULATE INITIAL PIPE SIZES 

505 IW=1 

510 FORI=1TONC:PS=SQR(.408*FL(I)/VM) 

511 GOSUB8000 
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512 NEXTI 

515 CLS:PRINT"INITIAL PIPE SIZES FOR NOMINAL VELOCITY OP" ,-VM; "FPS" : PRINT 

517 FORI=1TONC:GOSUB3000:PRINTUSING"S#I.##";SP(IS(I));:PRINT" INCHES" : IFINTU/10 

)*10ORI=NCTHENGOSUB9000:CLS 

518 NEXTI 

520 IFIW=2THEN620 

525 PRINT-INPUT THE TOTAL K-VALUE FOR EACH BRANCH, INCLUDING ALL VALVES S FITTIN 

GS:":PRINT 
530 FORI=1TONC:GOSUB3000:INPUTXK(I) :NEXTI 
590 ' 

600 ' CALCULATE PRESSURE DROP FOR EACH PIPE SEGMENT 
610 ' 

620 FORI=1TONC:GOSUB4000:NEXTI 
630 ' 

640 ' CALCULATE PRESSURE AT THE END OF EACH BRANCH 
650 * 

660 GOSUB5000 
670 ' 

680 ' CHECK FOR MINIMUM PRESSURE REQUIREMENT 
690 ' 

700 FORI=lTOIP 
710 IFPE(I)<AP(I)THEN800 
720 NEXTI 
730 GOTO900 
800 ■ 

810 ■ ADJUST PIPE SIZES 
820 ' 

830 GOSUB6000 
840 GOTO700 
900 ■ 
910 CLS:PRINTTAB(20)"PIPE SIZE, IN. "; TAB (40) "VELOCITY, FPS" :PRINTTAB( 20) STRINGS ( 

14,"-") ;TAB(40)STRING?(13,"-") : 
920 FORI=1TONC:GOSUB3000:PRINTUSING"*##S##.I#";SP(IS(I)) ; 
922 V=.408*FL{I)/SQ(IS(D) [2 
924 PRINTUSING"###i######*t#t##.«";V 
930 IFI=NCORI=INT(I/10)*10THENGOSUB9000:CLS 
950 NEXTI 

1040 CLS:PRINT"RESIDUAL PRESSURES ARE:":PRINT 
1050 FORI=lTOIP:PRINT"NODE";:PRINTUSING"##t";LP(I,l);:PRINT": " ;:PRINTUSING"###. 

#";PE(I);:PRINT" PSI":IFINT(I/10) *10=ITHENGOSUB9000:CLS 
1060 NEXTI 

1070 PRINT: INPUT"ANOTHER CASE (Y/N)";BS 
1080 IFBS="N"THENEND 

1090 INPUT"DO YOU WISH TO CHANGE THE MAXIMUM VELOCITY" ;B$ 
1100 IFB$="Y"THENINPUT"VELOCITY";VM 
1105 IW=2:IFA$="F"THEN510 

1110 INPUT"DO YOU WISH TO CHANGE THE MINIMUM PRESSURE" ;B$ 
1120 IFB$="Y"THENINPUT"PRESSURE";PM:FORI=lTOIP:AP(I)=PM:NBXTI 
1130 GOTO510 

2000 ' FLOW PATH MATRIX— LP 
2010 IP=0 
2020 FORI=2TONN 
2030 FORJ=lTONC 
2040 IFII(J)=ITHEN2200 
2050 NEXT J 

2060 IP=IP+1:LP(IP,1)=I:IQ=1:IS=I 
2070 FORJ=lTONC 
2080 IFJJ(J)=ISTHEN2110 
2090 NEXTJ 

2100 PRINT"NODE";I;"NOT CONNECTED" :STOP 
2110 IQ=IQ+1:LP(IP,IQ)=II(J) :IFII(J)=1THEN2200 
2120 IS=II(J) :GOTO2070 
2200 NEXTI 

2210 CLS:PRINT"NODE NUMBERS FOR EACH POSSIBLE FLOW PATH ARE:":PRINT 
2220 FORI=lTOIP 

2230 PRINT"PATH";:PRINTUSING"###";I;:PRINT": 
2240 IQ=1 

2250 PRINTUSING"##t#";LP(I,IQ) ; 
2260 IFLP(I,IQ)=1THEN2280 
2270 IQ=IQ+1:GOTO2250 
2280 PRINT 
2290 NEXTI 

2300 GOSUB9000:RETURN 
2500 ■ 

2510 • DIMENSION STATEMENTS WITH VARIABLE DEFINITIONS 

2520 • 

2530 DIM 11(50)' THE "FROM" NODE NUMBER IN EACH SEGMENT 

2540 DIM JJ(50)' THE "TO" NODE NUMBER IN EACH SEGMENT 

2550 DIM XL(50)' THE LENGTH OF EACH SEGMENT IN FEET 

2560 DIM LP(20,20)' MATRIX GIVING THE NODE NUMBERS IN EACH 

2570 ' FLOW PATH FROM THE OUTLET BACK TO THE 

2580 ' METER (NODE 1) 

2590 DIM FL(50)' FLOW IN EACH SEGMENT, GPM, OR FIXTURE 

2595 ■ UNITS 

2600 DIM IS(50)' CODE NUMBER (1-13) FOR SEGMENT SIZES 

2610 DIM DP(50)' PRESSURE DROP IN EACH SEGMENT, PSI 

2620 DIM XK(50)' K-VALUES FOR EACH SEGMENT 
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2630 DIM PE(20)' RESIDUAL PRESSURES AT THE DISCHARGE 

26 40 ' POINTS, PSI 

2650 DIM SP(13) • NOMINAL SIZES OF COMMERCIALLY AVAILABLE 

2655 ' TYPE L COPPER PIPE 

2660 DIM SQU3) ' ACTUAL I.D. OP PIPE SIZES 

2670 DIM A(3,6)' COEFFICIENTS FOR CONVERTING FROM 

26 80 ' FIXTURE UNITS TO GPM 

2690 DIM EL(50) ' ELEVATION OF EACH NODE ABOVE NODE 1 
2700 DIM AP(20)' MINIMUM PRESSURE AT EACH DISCHARGE 
2710 ' POINT, PSI 

27 20 RETURN' 

3000 ' PRINTING ROUTINE 

3010 PRINT"NODE"i:PRINTUSING"#*»";II(I);:PRINT" TO NODE"::PRINTUSING"#»t" ;JJ (I) ; 

: PRINT": ";: RETURN 
4000 ' PIPE SEGMENT PRESSURE DROPS 
4020 • HAZEN/WILLIAHS 
4025 PS=SQ(IS(D) 

4030 DP(I)=(FL(I)/.443/140/PS[2.63) [1.85*XL(D 
4040 ' EFFECT OF FITTINGS 6 VALVES 
4050 V=.408*FL(I)/PS[2 

4060 DP(I)=DP(I)+XK(I)*62.4*V[2/144/2/32.2 
407 ' EFFECT OF ELEVATION DIFFERENCES 
4080 DP(I)=DP(I)+(EL(JJ(I))-EL(II(I)))/2.31 
4090 RETURN 

5000 ' TOTAL PRESSURE DROP FOR EACH FLOW PATH 
5010 FORI=lTOIP 
5020 PE(I)=0 
5030 IQ=2 

5040 IFLP(I,IQ-1)=1THEN5100 
5050 FORJ=1TONC 

5060 IFLP(I,IQ)=II(J)ANDLP(I,IQ-1)=JJ(J)THEN5080 
5070 NEXTJ 

5080 PE(I)=PE(I)+DP(J) 
5090 IQ=IQ+1:GOTO5040 
5100 PE(I)=PP-PE(I) 
5110 NEXTI 
5120 RETURN 

6000 ' INCREASE THE SIZE OF THE PIPE WITH THE HIGHEST TOTAL 
6010 " PRESSURE DROP (IGNORINNG ELEVATION CHANGE) IN THE 
6020 ' BRANCH WHERE THE RESIDUAL PRESSURE IS THE FURTHEST FROM 
6025 ' THE REQUIRED MINIMUM PRESSURE 
6030 DD=0 
6040 FORI=lTOIP 
6050 IFPE(I)>AP(I)THEN6060 

6055 IF(AP(I)-PE(I))>DDTHENDD=AP(I)-PE(I) :J = I 
6060 NEXTI 
6070 IQ=2:DD=0 
6080 IFLP(J,IQ)=0THEN6150 
6090 FORI=lTONC 

6100 IFLP(J,IQ)=II(I)ANDLP(J,IQ-1)=JJ{I)THEN6120 
6110 NEXTI 

6120 DQ=DP(I)-(EL(JJ(I))-EL(II(I)))/2.31 
6125 IFDQ>=DDANDIS(IX13THENDD=DQ:K=I 
6130 IQ=IQ+1:GOTO6080 
6150 I=K:IS(I)=IS(I)+1 

6160 GOSUB3000:PRINT"PIPE SIZE CHANGED TO" ;SP( IS ( I) ) ; "INCHES" 
617 DX=DP(I) 
6175 ' 

6180 ' CALCULATE NEW PRESSURE DROP 
6190 ' 

6200 GOSUB4000 
6210 ' 

6220 ' ADJUST RESIDUAL PRESSURES 
6230 ' 

6240 FORJ=lTOIP 
6250 IQ=2 

6260 IFLP(J,IQ-1)=1THEN6400 

6270 IFLP(J,IQ)=II<I)ANDLP(J,IQ-1)=JJ<I)THENPE(J)=PE<J)+DX-DP(I):GOTO6400 
6350 IQ=IQ+1:GOTO6260 
6400 NEXTJ 
6410 RETURN 

6500 ' CONVERT FROM FIXTURE UNITS TO FLOWS IN GPM 
6510 F0RI=1T03:F0RJ=1T06:READA(I,J) :NEXTJ,I 
6541 CLS:PRINT"FIXTURE UNIT COUNT":PRINT 
6550 FORI=lTONC 

6552 IG=2:IFFL(I)<0THENIG=1:FL(I)=-FL(I) 
6556 GOSUB3000:PRINTUSING"###S#";FL(I) 
6558 IFI=NCORI=INT(I/10)*10THENGOSUB9000:CLS 
6560 ID=3:IFFL(I)>900THEN6600 
6562 ID=2:IFIG=1THENID=1:GOTO6600 
6564 IFFL(I)>=8THEN6600 

6566 IFFL(I)>=3THENFL(I)=FL(I)-1:RETURN 
6568 IFFL(I)=2TBENFL(I)=1.5:RETURN 
6570 PL ( I) =1: RETURN 
6580 ID=2:IFFL(I)<=2THEN6600 
6590 ID=1 
6600 X=LOG(LOG(FL(I))) 
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6610 Y=B 

6620 F0RJ=1T06 

6630 Y=A(ID,J)+X*Y 

6640 NEXTJ 

6650 FL(I)=EXP(Y) 

6660 NEXTI 

6670 RETURN 

7000 ' COMMERCIALLY AVAILABLE PIPE SIZES S, ACTUAL I.D.'S 

7010 F0RI=1T013:READSP(I) ,SQ(I) :NEXTI:RETURN 

7500 ' FIND OUT IF REQUIRED RESIDUAL PRESSURE CANNOT BE MET 

7510 ' WITH ANY PIPE SIZE DUB TO LARGE ELEVATION CHANGES 

7520 12-1 

7530 FORJ=lTOIP 

7540 PR=PP-EL(LP(J,1))/2.31 

7560 IFPR>AP(J)THEN7600 

7570 IFI2=1THENIZ=2:CLS:PRINT"PRESSURE REQUIREMENT CANNOT BE MET AT THE FOLLOWIN 

G":PRINT"NODE(S) BECAUSE OF EXCESSIVE ELEVATION CHANGE: " :PRINT 
7580 PRINTLP(J,1), 
7600 NEXTJ 

7610 IFIZ=2THENENDELSERETURN 

8000 ' TAKE AN INITIAL PIPE SIZE AND ADJUST IT TO COMMERCIALLY 
8010 ' AVAILABLE SIZES 
8020 F0RJ=1T013 

8030 IFPS<=SQ(J)THENIS(I)=J:GOTO8090 
8040 NEXTJ 

8080 IS(I)=13:RETURN 
8090 V=.408*FL(I)/SQ(IS(D) [2 
8100 IFV>VMANDIS(IX>13THENIS(I)=IS(I)+1 
8110 RETURN 
9000 PRINT81000,"HIT ANY KEY TO CONTINUE" ;: FORK=1TO150 :NEXT: PRINTS1000 , STRING? ( 2 

3," ") i:FORK=lTO150:NEXT:IFINKEY$=""THEN9000ELSERETURN 



10010 ' DATA STATEMENTS 

10020 ' -, 

10030 ■ 

10040 ' PIPE SIZES 

10050 ' 

10060 DATA. 5,. 545,. 75,. 7 85, 1,1. 025, 1.25, 1.265, 1.5, 1.505, 2, 1.985 

10070 DATA2. 5, 2. 465, 3, 2. 945, 4, 3. 905, 6, 5. 845, 8, 7. 725, 10, 9. 625 

10080 DATA12,11.565 

10090 • 

10100 ' COEFFICIENTS FOR FIXTURE UNITS/FLOW CONVERSION 

10110 ' 

10120 DATA. 09811,. 05451, -1.35161, 3. 33835, -2. 25487, 3. 57 807 

10130 DATA. 4446 8, -.83676, -2. 49225, 8. 69041, -6. 56646, 3. 28639 

10140 DATA-. 11254,. 61512,. 23036, -3. 17483, 4. 14544, 1.98677 
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SOUNDEX CODE: by Robert Hodge 



If genealogical research is of 
interest to you, then this pro- 
gram will be right up your alley. 
It is designed to accurately gen- 
erate the Soundex Code. This 
code is used in the recordkeeping 
system at the National Archives, 
translate letter groups into num- 
bers and is based on phonics, 
rather than spelling. Plug the 
name in; out pop the numbers. 



; DC SOHCX-COK FOR 'PORT Bt 



iriw m «mo mil psess •am ononis .ra •w>. 



100 

105 
110 



120 

125 
130 
135 
140 
145 
150 
155 
160 
165 
170 
175 
180 
185 
190 
195 
200 
205 
210 
215 
220 
225 
230 
235 
240 
245 
250 
255 
260 
265 
27 
275 
280 
285 
290 
295 
300 
305 



PRINT TAB (20) "THE SOUNDEX CODE" 

PRINT:PRINT"A NUMBER OF RECORDS IN THE NATIONAL ARCHIVES HAVE BEEN INDEXED 
ACCORDING TO A SYSTEM ALLOWING SIMILAR SOUNDING NAMES TO BE GROUPED 
TOGETHER REGARDLESS OF SPELLING. THIS SYSTEM IS TERMED THE 'SOUNDEX SY 
STEM ' . " 

PRINT:PRINT"IF ONE IS GOING TO THE ARCHIVES, IT WOULD BE HELPFUL AND TIME- 
SAVING TO HAVE THE SOUNDEX CODES ALREADY AVAILBLE FOR THE SURNAMES (L 
AST NAMES) ONE WILL BE SEEKING." 

PRINT:PRINT"i AM PROGRAMMED TO DETERMINE THE SOUNDEX CODE FOR YOU" :PRINT: INP 
UT"TAP ENTER WHEN READY", -A 

DIMA${25),BS(25),C(25) 
CLS 

PRINT"TYPE THE SURNAME (LAST NAME) TO BE CODED AND PRESS ' ENTER' " : INPUT"" ;A$ 

A=LEN(A$) 

C(1)=ASC(LEFT$(A5,1)) 

FOR B=2 TO A 

B$(B)=MIDS(AS,B,1) 

NEXT B 

FOR B=2 TO A 

C(B)=ASC(B$(B)) 

NEXT B 

FOR B=l TO A 

IF C(B)=66 OR C(B)=70 OR C(B)=80 OR C(B)=86 THEN C(B)=1 

IF C(B)=67 OR C(B)=71 OR C(B)=74 OR C(B)=75 THEN C(B)=2 

IF C(B)=81 OR C(B)=83 OR C(B)=88 OR C(B)=90 THEN C(B)=2 

IF C(B)=68 OR C(B)=84 THEN C(B)=3 

IF C(B)=77 OR C(B)=78 THEN C(B)=5 

IF C(B)=76 THEN C(B)=4 

IF C(B)=82 THEN C(B)=6 

IF C(B)>6 THEN C(B)=0 

IF C(B-1)=C(B) THEN C(B)=0 

NEXT B 

CLS:X=0 

PRINT"THE SOUNDEX CODE FOR '"AS"' IS:" 

PRINT:PRINT:PRINT LEFT$(AS,1), 

FOR B=2 TO A 

IF C(B)=0 GOTO 275 

PRINT C(B) , 

X=X+1 

IF X=3 GOTO 295 

NEXT B 

FOR B=l TO 3-X 

PRINT "0", 
NEXT B 

PRINT: INPUT" IF YOU HAVE ANOTHER NAME, PRESS 

IF A$="NO" GOTO 305ELSE 130 

CLS : END 



'ENTER' OTHERWISE TYPE 'NO'";A$ 
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CALENDAR: by Jim Malone 



Valid for the period from 
January, 4713 B.C. to December 
31, 9999, this clever program 
will find great applications 
among astronomers or anyone 
else interested in converting 
from Julian to Gregorian systems 
of date keeping. A pictoral repre- 
sentation of any monthly calen- 
dar during that period is also 
provided. 



10 

20 




90 
100 
110 
120 



140 
150 
160 

17 
180 
190 
200 
210 
220 
230 
240 
250 

26 

27 
280 
290 
300 
310 
320 
330 
340 
350 
360 
370 
380 
390 
400 
410 
420 
430 
440 
450 
460 



CLEAR:DIM B(38) :DBFDBL J,D,H,Y,K,A 

DATA 275,281,287,293,299,305,333,339,345,351,357,363,369,397,403,409,415,421, 

427,433,461,467,473,479,485,491,497,525,531,537,543,549,555,561,589,595,601 
CLS:PRINT "THIS PROGRAM WILL ACCEPT ANY DATE IN THE DISTANT PAST TO THE DI 

STANT FUTURE AND DISPLAY THE CALENDAR FOR THAT MONTH ALONG "i 
PRINT" WITH THE JULIAN DAY NUMBER."; 
PRINT" THIS PROGRAM WILL ACCEPT EITHER JULIAN DATE (CIVIL SYSTEM) OR GREG 

ORIAN DATE. IT AUTOMATICALLY CHANGES FROM ONE SYSTEM TO THE OTHER ON JULIA 

N DAY NUMBER 2299160 (4 OCT. 1582),"; 
PRINT "TO THE GREGORIAN DATE OF 15 OCT. 1582 (JD# 2299161)."" IN THE JULI 

AN CALENDAR (CIVIL SYSTEM) THEIR IS NO YEAR 0. THE CALENDAR JUMPS FROM 1 

BC (-1) TO 1 AD (1). THE JULIAN CALENDAR STARTS AT 1 JAN. 4713 BC . " 
PRINT: PRINT"THIS PROGRAM IS VALID FROM 1 JAN. 4713 BC TO 31 DEC. 9999 AD" 
PRINT: PRINT"THE BC YEARS ARE INPUT AS NEGATIVE YEARS, WHILE THE AD YEARS AREI 

NPUT AS POSTIVE YEARS. E.G. MM,DD,-YYYY FOR BC." 
PRINT: INPUT'DO YOU WISH TO CONTINUE Y/N";LS:IF L$="Y" THEN 120 
IF L$="N" THEN CLS 

CLS:PRINT"TYPE RUN AND 'ENTER' TO START OVER" ;: END 
RESTORE:CLS:PRINTe0,"JAN=l (31 DAYS) " ; : PRINT664 , "FEB=2 (28 DAYS EXCEPT FOR L 

EAP YEAR THEN 29 DAYS) " ; : PRINT6128 , "MAR=3 (31 DAYS) " ; : PRINT8192 , "APR=4 (30 

DAYS)";:PRINTe256,"MAY=5 (31 DAYS) " ; : PRINT6320 , "JUN=6 (30 DAYS) "; :PRIST@384 

, "JUL=7 (31 DAYS)"; 
PRINT@448,"AUG=8 (31 DAYS) " ; : PRINT8512, "SEP=9 (30 DAYS) " ; : PRINT6576, "OCT=10 

(31 DAYS)";:PRINT6640,"NOV=11 (30 DAYS) " ; :PRINT8704 ,"DEC=12 (31 DAYS)";:PRI 

NT8960,;: INPUT" INPUT DATE ' MM,DD, YYYY ' " ;MA,DA, YA 
IF YA<-4713 THEN PRINT"DATE LESS THAN 4713BC. " ; : GOTO 340 
IF YA>9999 THEN PRINT"DATE MORE THAN 9999AD. ";:GOTO 340 
IF YA=0 THEN PRINT'THEIR IS NO YEAR IN THE JULIAN (CIVIL SYSTEM) CALENDAR. 

";:GOTO 340 
IF YA=1582 THEN 1310 

IF MA<1 THEN PRINT"NOT A VALID DATE. " ; : GOTO 340 
IF MA>12 THEN PRINT'NOT A VALID DATE. " ; : GOTO 340 
IF DA<1 THEN PRINT"NOT A VALID DATE. ";:GOTO 340 
IF MA=1 THEN GOSUB 1470 
IF MA=2 THEN GOSUB 14 90 
IF MA=3 THEN GOSUB 1470 
IF MA=4 THEN GOSUB 1510 
IF MA=5 THEN GOSUB 1470 
IF MA=6 THEN GOSUB 1510 
IF MA=7 THEN GOSUB 1470 
IF MA=8 THEN GOSUB 1470 
IF MA=9 THEN GOSUB 1510 
IF MA=10 THEN GOSUB 1470 
IF MA=11 THEN GOSUB 1510 
IF MA=12 THEN GOSUB 1470 
GOTO 35 

PRINT"TYPE RUN AND 'ENTER' TO START OVER.";:END 
M=MA:Y=YA:D=DA:CLS 
GOSUB 600 

IF JD>2299160 THEN GOSUB 900 ELSE GOSUB 690 
PRINT8709, "JULIAN DAY NUMBER=" ; JD; " FOR THE DATE";M;"/" 
M=MA:Y=YA:D=1 



D;"/";Y; 



GOSUB 600 

IF JD=>2299170 THEN GOSUB 900 ELSE GOSUB 690 

FOR Z = 1 TO 37 

READ B(Z) 

NEXT Z 

FOR Z=l TO 7 
IF Z»DW THEN 480 
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470 NEXT Z 

480 F»B(Z) :PRINT8F,D;iZl-Z 

490 FOR Z-Zl+1 TO 38 

500 JD-JD+1 

510 IF JD»>2299161 THEN GOSUB 900 ELSE GOSUB 690 

520 IF HAOM THEN 1070 

530 F-B(Z) :PRINT6F,D; 

540 NEXT Z 

550 STOP 

560 END 

570 END 

580 CLS: PRINT 6 960, "INPUT "; 

590 INPUT"MM,DD,YYYY"jM,D,Y 

600 IF Y<=0 THEN Y=Y+1 

610 A=FIX((M--14)/12> 

620 JD»FIX((Y+A+4800)*1461/4)+FIX(((M-2)-(A*12))»30.59)+D-32113 

630 IF JD=>2299170 THEN 650 

640 RETURN:END 

650 JD=JD-FIX(.75*FIX((Y+100+A)/100))+2 

660 RETURN 

670 END 

680 END 

690 DN=JD-1720995 

700 IF DN=>123 THEN K3=B 

710 IF DN<123 THEN K3=365.25 

720 Y2=FIX((DN-122.1-K3)/365.25) 

730 IF Y2=>0 THEN Y3=Y2 

740 IF Y2<0 THEN Y3=Y2+1 

750 IF Y2=>0 THEN K2=0 

760 IF Y2<0 THEN K2=366 

770 M1=FIX((DN-FIX (365. 25*Y3) +K2)/30 . 6001) 

780 IF Ml=14 THEN H=M1-13 

790 IF Ml=15 THEN M=M1-13 

800 IF MK14 THEN H=M1-1 

810 IF M>2 THEN Y1=Y2 

820 IF M=l THEN Y1=Y2+1 

830 IF M=2 THEN Y1=Y2+1 

840 IF Y1>0 THEN Y=Y1 

850 IF Y1<=0 THEN Y=Y1-1 

860 D=DN-FIX(365.25*Y3)-FIX(30.6001*M1)+K2 

870 DW=JD/7:DW=1+FIX(7*ABS(DW-FIX(DW)) ) 

880 RETURN 

890 END 

900 K=(-FIX(Y/100)+FIX(Y/400)) 

910 DN=JD-17 20997 

920 Yl=FIX((DN-122.1-K)/365.25) 

930 M1=FIX((DN-FIX( 365. 25*Y1) -K)/30 . 6001) 

940 IF Ml=14 THEN M=M1-13 

950 IF Hl=15 THEN M=M1-13 

960 IF HK14 THEN M=M1-1 

970 IF M>2 THEN Y=Y1 

980 IF H=l THEN Y=Y1+1 

990 IF M=2 THEN Y=Y1+1 

1000 D=DN~FIX(365.25*Y1)-FIX(30.6001*M1)-K 

1010 DW=JD/7:DW=1+FIX(7*ABS(DW-FIX(DW))) 

1020 RETURN 

1030 END 

1040 END 

1050 'THIS PORTION OF PROG. IS PART OF CAL. DISPLAY 

1060 CLS 

1070 PRINT894,YA 

1080 IF MA=1 THEN M$="JAN." 

1090 IF MA=2 THEN MS="F£B." 

1100 IF HA=3 THEN M$="MAR." 

1110 IF MA=4 THEN M$="APR." 

1120 IF HA=5 THEN MS="MAY." 

1130 IF HA=6 THEN M?="JUN." 

1140 IF HA=7 THEN M$="JUL." 

1150 IF HA=8 THEN M$="AUG." 

1160 IF HA=9 THEN M$="SEP." 

1170 IF MA=10 THEN M$="OCT." 

1180 IF HA=11 THEN M$="NOV. " 

1190 IF MA=12 THEN M$="DEC." 

1200 PRINT@159,M$ 

1210 PRINTS205 , "SUN" ; : PRINT8211 , "HON" ; : PRINT6217 , "TUE" ; : PRINT6223 , "WED" ; : PRINT62 

29 , "THU" ; : PRINT8235 , "FRI " ; : PRINTC241 , "SAT" ; 
1220 FOR X=19 TO 109 
1230 SET (X,0) :SET(X,30) 
1240 NEXT X 
1250 FOR Z=0 TO 30 
1260 SET(19,Z) :SET(109,Z) 
1270 NEXT Z 

1280 PRINT@960,"DO YOU WISH TO ENTER ANOTHER DATE 'Y/N'"; 
1290 INPUT L5 

1300 IF L$="Y" THEN 120 ELSE CLS : END 
1310 IF HA=10 THEN 1330 
1320 GOTO 180 
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1330 IF DA=5 THEN 1440 

1340 IF DA=6 THEN 1440 

1350 IF DA=7 THEN 1440 

1360 IF DA=8 THEN 1440 

1370 IF DA=9 THEN 1440 

1380 IF DA=10 THEN 1440 

1390 IF DA=11 THEN 1440 

1400 IF DA=12 THEN 1440 

1410 IF DA=13 THEN 1440 

14 20 IF DA=14 THEN 14 40 

1430 GOTO 180 

1440 PRINT"THIS DAY WAS LOST WHEN THE CALENDAR WAS CONVERTED FROM JULIAN TOGREGO 

RIAN. ";:GOTO 340 
1450 END 
1460 END 

1470 IF DA>31 THEN 1530 ELSE RETURN 
1480 END 

1490 IF DA>29 THEN 1530 ELSE RETURN 
1500 END 

1510 IF DA>30 THEN 1530 ELSE RETURN 
1520 END 
1530 PRINT'NOT A VALID DATCLEARENDDATAMKI$LOC4ENDSTEP/VARPTRBNDT 
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Instant Software Inc 



Peterboromjh, New Hampshire 03458 603-924-7296 



Electronic Circuit Design . . . Video Graphics . . . Arcade 
Games . . . Utilities . . . Engineering Problems . . . Board 
Games . . . Tutorials . . . Scorekeeping . . . Sound Effects 
. . . Salvage Values . . . Artifical Intelligence . . . Insur- 
ance Comparison . . . Combat Simulation . . . Ball Games 
. . . Computer Music . . . Statistical Predictions . . . LIFE 
. . . Demonstration Packages . . . Number Crunching . . . 
Just For Kids . . . Automotive Expenses . . . ESP Testing 
. . . Antenna Design . . . Loan Amortization . . . Graphic 
Displays . . . Casino Games . . . Weather Forecasting . . . 
Depreciation Analysis . . . Computer-Aided Instruction 
. . . Swords and Sorcery . . . Real-Time Simulation . . . 
Space Treks . . . Personal Finance . . . L«oic Puzzles . . . 
Electronic Circuit Design . . . VideaGraAcs . . . Arcade 
Games . . . Utilities . . . Engine % J^robl^fns . . . Board 
Games . . . Tutorials . . . Scorekem^ . . Sound JE ffects 
. . . Salvage Vakies^^ C% il witelligt £&■■ Insur- 
ance Compos 1. 9w**" SimulaUpft .. . Ball Games 
. . . Comput^^^kiftrr Statist^jM^redictions ... LIFE 
. . . Demonstr%ion Packaged®. . Number Crunching . . . 
Just For Kids . . . Au^dlnbtive Expenses . . . ESP Testing 
. . . Antenna^v&gn . . . Loan Amortization . . . Graphic 
Displays . . /Casino Games . . . Weather Forecasting . . . 
Depreciation Analysis . . . Computer-Aided Instruction 
. . . Swords and Sorcery . . . Real-Time Simulation . . . 
Space Treks . . . Personal Finance . . . Logic Puzzles . . . 
Electronic Circuit Design . . . Video Graphics . . . Arcade 
Games . . . Utilities . . .Engineering Problems . . . Board 
Games . . . Tutorials . . . Scorekeeping . . . Sound Effects 
. . . Salvage Values . . . Artifical Intelligence . . . Insur- 
ance Comparison . . . Combat Simulation . . . Ball Games 
. . . Computer Music . . . Statistical Predictions . . . LIFE 
. . . Demonstration Packages . . . Number Crunching . . . 
Just For Kids . . . Automotive Expenses . . . ESP Testing 
. . . Antenna Design . . . Loan Amortization . . . Graphic 
^Displays . . . Casino G ames . . . Weather Forecasting . . . 



